mirror-github-bspeice/apophysis
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

correct aspect ratio in fullscreen

Browse Source
This commit is contained in:
zueuk 2006-04-13 16:10:47 +00:00
parent 49156a4e10
commit 67929c1589
2 changed files with 57 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
2.10/Source/Fullscreen.dfm
View File

@ -24,7 +24,6 @@ object FullscreenForm: TFullscreenForm
Top = 0 Top = 0
Width = 186 Width = 186
Height = 131 Height = 131
Align = alClient
OnDblClick = ImageDblClick OnDblClick = ImageDblClick
end end
end end

74
2.10/Source/Fullscreen.pas
View File

@ -34,7 +34,11 @@ type
procedure ImageDblClick(Sender: TObject); procedure ImageDblClick(Sender: TObject);
private private
Remainder, StartTime, t: double; Remainder, StartTime, t: double;
imgLeft, imgTop,
imgWidth, imgHeight: integer;
Renderer: TRenderThread; Renderer: TRenderThread;
procedure showTaskbar; procedure showTaskbar;
procedure hideTaskbar; procedure hideTaskbar;
procedure DrawFlame; procedure DrawFlame;
@ -61,8 +65,26 @@ uses Main, Math, Global;
procedure TFullscreenForm.DrawFlame; procedure TFullscreenForm.DrawFlame;
var
r: double;
begin begin
cp.AdjustScale(Image.Width, Image.Height); if (cp.width / cp.height) > (ClientWidth / ClientHeight) then
begin
imgWidth := ClientWidth;
r := cp.width / imgWidth;
imgHeight := round(cp.height / r);
imgLeft := 1;
imgTop := (ClientHeight - imgHeight) div 2;
end
else begin
imgHeight := ClientHeight;
r := cp.height / imgHeight;
imgWidth := round(cp.Width / r);
imgTop := 1;
imgLeft := (ClientWidth - ImgWidth) div 2;
end;
cp.AdjustScale(imgWidth, imgHeight);
// cp.Zoom := MainForm.Zoom; // cp.Zoom := MainForm.Zoom;
// cp.center[0] := MainForm.center[0]; // cp.center[0] := MainForm.center[0];
// cp.center[1] := MainForm.center[1]; // cp.center[1] := MainForm.center[1];
@ -70,21 +92,26 @@ begin
StartTime := Now; StartTime := Now;
t := now; t := now;
Remainder := 1; Remainder := 1;
if Assigned(Renderer) then begin if Assigned(Renderer) then begin
// Hmm... but how can it be assigned & running here, anyway? :-\
Renderer.Terminate; Renderer.Terminate;
Renderer.WaitFor; Renderer.WaitFor;
Application.ProcessMessages;//Renderer.Free;
Application.ProcessMessages; // HandleThreadTermination kinda should be called here...(?)
Renderer.Free;
Renderer := nil;
end; end;
assert(not assigned(renderer), 'Render thread is still running!?'); assert(not assigned(renderer), 'Render thread is still running!?');
if not Assigned(Renderer) then
begin Renderer := TRenderThread.Create;
Renderer := TRenderThread.Create; Renderer.TargetHandle := Handle;
Renderer.TargetHandle := Handle; Renderer.OnProgress := OnProgress;
Renderer.OnProgress := OnProgress; Renderer.Compatibility := Compatibility;
Renderer.Compatibility := Compatibility; Renderer.SetCP(cp);
Renderer.SetCP(cp); Renderer.Resume;
Renderer.Resume;
end;
end; end;
procedure TFullscreenForm.HandleThreadCompletion(var Message: TMessage); procedure TFullscreenForm.HandleThreadCompletion(var Message: TMessage);
@ -95,6 +122,7 @@ begin
begin begin
bm := TBitmap.Create; bm := TBitmap.Create;
bm.assign(Renderer.GetImage); bm.assign(Renderer.GetImage);
Image.SetBounds(imgLeft, imgTop, imgWidth, imgHeight);
Image.Picture.Graphic := bm; Image.Picture.Graphic := bm;
// Canvas.StretchDraw(Rect(0, 0, ClientWidth, ClientHeight), bm); // Canvas.StretchDraw(Rect(0, 0, ClientWidth, ClientHeight), bm);
@ -123,12 +151,19 @@ end;
procedure TFullscreenForm.OnProgress(prog: double); procedure TFullscreenForm.OnProgress(prog: double);
begin begin
prog := (Renderer.Slice + Prog) / Renderer.NrSlices; prog := (Renderer.Slice + Prog) / Renderer.NrSlices;
Canvas.Brush.Color := clTeal; if prog = 1 then
Canvas.FrameRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5)); begin
Canvas.Brush.Color := clTeal; Canvas.Brush.Color := clBlack;
Canvas.Fillrect(Rect(7, ClientHeight - 13, 7 + Round(prog * (ClientWidth - 14)), ClientHeight - 7)); Canvas.FillRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5));
Canvas.Brush.Color := clBlack; end
Canvas.Fillrect(Rect(7 + Round(prog * (ClientWidth - 14)), ClientHeight - 13, ClientWidth - 7, ClientHeight - 7)); else begin
Canvas.Brush.Color := clTeal;
Canvas.FrameRect(Rect(5, ClientHeight - 15, ClientWidth - 5, ClientHeight - 5));
Canvas.Brush.Color := clTeal;
Canvas.Fillrect(Rect(7, ClientHeight - 13, 7 + Round(prog * (ClientWidth - 14)), ClientHeight - 7));
Canvas.Brush.Color := clBlack;
Canvas.Fillrect(Rect(7 + Round(prog * (ClientWidth - 14)), ClientHeight - 13, ClientWidth - 7, ClientHeight - 7));
end;
Application.ProcessMessages; Application.ProcessMessages;
end; end;
@ -152,6 +187,11 @@ end;
procedure TFullscreenForm.FormShow(Sender: TObject); procedure TFullscreenForm.FormShow(Sender: TObject);
begin begin
if Image.Width < ClientWidth then
Image.Left := (ClientWidth - Image.Width) div 2;
if Image.Height < ClientHeight then
Image.Top := (ClientHeight - Image.Height) div 2;
MainForm.mnuFullScreen.enabled := true; MainForm.mnuFullScreen.enabled := true;
HideTaskbar; HideTaskbar;
if calculate then if calculate then