fixed zooming bug in main window

This commit is contained in:
zueuk 2006-09-27 14:52:07 +00:00
parent 2c9a9705cc
commit 07078fa223
8 changed files with 48 additions and 36 deletions

View File

@ -1904,7 +1904,7 @@ object AboutForm: TAboutForm
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
OnClick = Label4Click
OnClick = DevelopersClick
end
object Label10: TLabel
Left = 120
@ -1934,7 +1934,7 @@ object AboutForm: TAboutForm
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
OnClick = lblFlamecomClick
OnClick = DevelopersClick
end
object Label5: TLabel
Left = 120

View File

@ -49,8 +49,6 @@ type
Bevel2: TBevel;
Bevel3: TBevel;
procedure btnOKClick(Sender: TObject);
procedure Label4Click(Sender: TObject);
procedure lblFlamecomClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure lblCreditClick(Sender: TObject);
procedure DevelopersClick(Sender: TObject);
@ -75,18 +73,6 @@ begin
ModalResult := mrOK;
end;
procedure TAboutForm.Label4Click(Sender: TObject);
begin
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar('http://www.apophysis.org'),
nil, nil, SW_SHOWNORMAL);
end;
procedure TAboutForm.lblFlamecomClick(Sender: TObject);
begin
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar('http://flam3.com'),
nil, nil, SW_SHOWNORMAL);
end;
procedure TAboutForm.FormShow(Sender: TObject);
begin
lblCredit.Caption := MainCp.Nick;

View File

@ -1775,14 +1775,14 @@ begin
end;
MainForm.SetBounds(l, t, w, h);
end
else MainForm.RedrawTimer.Enabled := true;
end;
MainForm.RedrawTimer.Enabled := true;
end;
procedure TAdjustForm.GetMainWindowSize;
begin
ImageWidth := MainCP.Width; //MainForm.Image.Width;
ImageHeight := MainCP.Height; //MainForm.Image.Height;
ImageWidth := MainCP.Width;
ImageHeight := MainCP.Height;
txtWidth.text := IntToStr(ImageWidth);
txtHeight.text := IntToStr(ImageHeight);
end;

View File

@ -223,12 +223,18 @@ begin
if Indices.Count = 0 then raise EFormatInvalid.Create('No color info');
for i := 0 to Indices.Count - 1 do
begin
try
index := StrToInt(Indices[i]);
while index < 0 do inc(index, 400);
index := Round(Index * (255 / 399));
indices[i] := IntToStr(index);
assert(index>=0);
assert(index<256);
Result[index][0] := StrToInt(Colors[i]) mod 256;
Result[index][1] := trunc(StrToInt(Colors[i]) / 256) mod 256;
Result[index][2] := trunc(StrToInt(Colors[i]) / 65536);
except
end;
end;
i := 1;
repeat

View File

@ -50,6 +50,9 @@ type
x: double;
y: double;
end;
TSRect = record
Left, Top, Right, Bottom: double;
end;
TMapPalette = record
Red: array[0..255] of byte;
Green: array[0..255] of byte;
@ -182,10 +185,10 @@ type
constructor Create;
destructor Destroy; override;
procedure ZoomtoRect(R: TRect);
procedure ZoomOuttoRect(R: TRect);
procedure ZoomtoRect(R: TSRect);
procedure ZoomOuttoRect(R: TSRect);
procedure MoveRect(R: TSRect);
procedure ZoomIn(Factor: double);
procedure MoveRect(R: TRect);
procedure Rotate(Angle: double);
property ppux: double read getppux;
@ -1688,7 +1691,7 @@ end;
*)
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.ZoomtoRect(R: TRect);
procedure TControlPoint.ZoomtoRect(R: TSRect);
var
scale, ppu: double;
dx,dy: double;
@ -1709,7 +1712,7 @@ begin
end;
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.ZoomOuttoRect(R: TRect);
procedure TControlPoint.ZoomOuttoRect(R: TSRect);
var
ppu: double;
dx, dy: double;
@ -1740,7 +1743,7 @@ begin
end;
///////////////////////////////////////////////////////////////////////////////
procedure TControlPoint.MoveRect(R: TRect);
procedure TControlPoint.MoveRect(R: TSRect);
var
scale: double;
ppux, ppuy: double;

View File

@ -335,11 +335,12 @@ begin
ImageHeight := StrToInt(cbHeight.text);
if not chkLimitMem.checked then begin
if (ApproxMemory > TotalPhysicalMemory) then
if (ApproxMemory > {Total}PhysicalMemory) then
begin
Application.MessageBox('You do not have enough memory for this render. Please use memory limiting.', 'Apophysis', 48);
exit;
end;
{
if (ApproxMemory > PhysicalMemory) then
begin
if Application.MessageBox('There is not enough memory for this render. ' + #13 +
@ -348,6 +349,7 @@ begin
'Dou you want to try? (SLOW AND UNSTABLE - USE AT YOUR OWN RISK!!!)', 'Apophysis',
MB_ICONWARNING or MB_YESNO) <> IDYES then exit;
end;
}
end
else if (PhysicalMemory < StrToInt(cbMaxMemory.text)) and (Approxmemory > PhysicalMemory) then begin
Application.MessageBox('You do not have enough memory for this render. Please use a lower Maximum memory setting.', 'Apophysis', 48);

View File

@ -39,7 +39,7 @@ const
RS_XO = 2;
RS_VO = 3;
AppVersionString = 'Apophysis 2.05 rc1';
AppVersionString = 'Apophysis 2.05 beta';
type
TMouseMoveState = (msUsual, msZoomWindow, msZoomOutWindow, msZoomWindowMove,
@ -3436,7 +3436,7 @@ var
begin
UpdateUndo;
scale := MainCP.pixels_per_unit * power(2, MainCP.zoom);
scale := MainCP.pixels_per_unit / MainCP.Width * power(2, MainCP.zoom);
cdx := MainCP.center[0];
cdy := MainCP.center[1];
@ -3453,10 +3453,10 @@ begin
dx := cdy*sina + cdx*cosa;
dy := (dx*cosa - cdx)/sina;
end;
FViewPos.x := FViewPos.x - dx * scale;
FViewPos.y := FViewPos.y - dy * scale;
FViewPos.x := FViewPos.x - dx * scale * Image.Width;
FViewPos.y := FViewPos.y - dy * scale * Image.Width;
FViewScale := FViewScale * MainCP.pixels_per_unit * power(2, MainCP.zoom) / scale;
FViewScale := FViewScale * MainCP.pixels_per_unit / MainCP.Width * power(2, MainCP.zoom) / scale;
DrawImageView;
@ -4380,11 +4380,20 @@ end;
FClickRect.BottomRight := Point(x, y);
end;
function ScaleRect(r: TRect; scale: double): TSRect;
begin
Result.Left := r.Left * scale;
Result.Top := r.Top * scale;
Result.Right := r.Right * scale;
Result.Bottom := r.Bottom * scale;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
scale: double;
rs: TSRect;
begin
case FMouseMoveState of
msZoomWindowMove:
@ -4393,11 +4402,11 @@ begin
FMouseMoveState := msZoomWindow;
if (abs(FSelectRect.Left - FSelectRect.Right) < 10) or
(abs(FSelectRect.Top - FSelectRect.Bottom) < 10) then
Exit; // zoom to much or double clicked
Exit; // zoom to much or double clicked
StopThread;
UpdateUndo;
MainCp.ZoomtoRect(FSelectRect);
MainCp.ZoomtoRect(ScaleRect(FSelectRect, MainCP.Width / Image.Width));
FViewScale := FViewScale * Image.Width / abs(FSelectRect.Right - FSelectRect.Left);
FViewPos.x := FViewPos.x - ((FSelectRect.Right + FSelectRect.Left) - Image.Width)/2;
@ -4417,7 +4426,7 @@ begin
StopThread;
UpdateUndo;
MainCp.ZoomOuttoRect(FSelectRect);
MainCp.ZoomOuttoRect(ScaleRect(FSelectRect, MainCP.Width / Image.Width));
scale := Image.Width / abs(FSelectRect.Right - FSelectRect.Left);
FViewScale := FViewScale / scale;
@ -4440,7 +4449,7 @@ begin
StopThread;
UpdateUndo;
MainCp.MoveRect(FClickRect);
MainCp.MoveRect(ScaleRect(FClickRect, MainCP.Width / Image.Width));
RedrawTimer.Enabled := True;
UpdateWindows;

View File

@ -269,12 +269,18 @@ begin
if Indices.Count = 0 then raise EFormatInvalid.Create('No color info');
for i := 0 to Indices.Count - 1 do
begin
try
index := StrToInt(Indices[i]);
while index < 0 do inc(index, 400);
index := Round(Index * (255 / 399));
indices[i] := IntToStr(index);
assert(index>=0);
assert(index<256);
Palette[index][0] := StrToInt(Colors[i]) mod 256;
Palette[index][1] := trunc(StrToInt(Colors[i]) / 256) mod 256;
Palette[index][2] := trunc(StrToInt(Colors[i]) / 65536);
except
end;
end;
i := 1;
repeat