Ver Fonte

Adapt Free Vision App to screen resize.

Margers há 1 mês atrás
pai
commit
a8e34cfbc9
1 ficheiros alterados com 34 adições e 1 exclusões
  1. 34 1
      packages/fv/src/app.inc

+ 34 - 1
packages/fv/src/app.inc

@@ -306,6 +306,7 @@ TYPE
       PROCEDURE GetTileRect (Var R: TRect); Virtual;
       PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
       procedure WriteShellMsg; virtual;
+      procedure ResizeApplication(x, y : sw_integer); Virtual;
    END;
    PApplication = ^TApplication;                      { Application ptr }
 
@@ -1062,6 +1063,12 @@ BEGIN
 {$else FV_UNICODE}
                {$IFDEF FPC_DOTTEDUNITS}FreeVision.{$ENDIF}Drivers.GetSystemEvent(Event);         { Load system event }
 {$endif FV_UNICODE}
+               if Event.What <> evNothing then
+                   { System events handle right away.
+                     Needed to respond correctly to cmResizeApp.
+                     If you need Event before hand then call GetSystemEvent(Event) instead. }
+                   HandleEvent (Event);
+
                If (Event.What = evNothing) Then
 {$ENDIF}
                  Idle;     { Idle if no event }
@@ -1183,6 +1190,7 @@ END;
 {---------------------------------------------------------------------------}
 PROCEDURE TApplication.DosShell;
 
+var PrevHeight,PrevWidth : Sw_Word;
 {$ifdef unix}
 var s:string;
 {$endif}
@@ -1211,6 +1219,8 @@ BEGIN                                                 { Compatability only }
   SwapVectors;
 {$endif}
 {  InitDosMem;}
+  PrevHeight:=ScreenHeight;
+  PrevWidth:=ScreenWidth;
 {$ifdef FV_UNICODE}
   {$IFDEF FPC_DOTTEDUNITS}FreeVision.{$ENDIF}udrivers.initkeyboard;
   {$IFDEF FPC_DOTTEDUNITS}FreeVision.{$ENDIF}udrivers.initvideo;
@@ -1223,7 +1233,12 @@ BEGIN                                                 { Compatability only }
   InitEvents;
   InitSysError;
   {$ifdef unix}InitClip(@Self);{$endif}
-  Redraw;
+  if (PrevHeight<>ScreenHeight) or (PrevWidth<>ScreenWidth) then
+    { acknowledge new screen dimensions }
+    { prevents to draw out of boundaries of new video buffer }
+    ResizeApplication(ScreenWidth,ScreenHeight)
+  else
+    Redraw;
 END;
 
 {--TApplication-------------------------------------------------------------}
@@ -1246,6 +1261,7 @@ BEGIN
        cmTile: Tile;                                  { Tile request }
        cmCascade: Cascade;                            { Cascade request }
        cmDosShell: DosShell;                          { DOS shell request }
+       cmResizeApp: ResizeApplication(Event.Id, Event.InfoWord); { Resize App }
        Else Exit;                                     { Unhandled exit }
      End;
      ClearEvent(Event);                               { Clear the event }
@@ -1258,6 +1274,23 @@ begin
   writeln(sTypeExitOnReturn);
 end;
 
+procedure TApplication.ResizeApplication(x, y : sw_integer);
+var
+  OldR : TRect;
+  Mode : TVideoMode;
+begin
+  GetBounds(OldR);
+  { adapt to new size }
+  if (OldR.B.Y-OldR.A.Y<>y) or
+     (OldR.B.X-OldR.A.X<>x) then
+    begin
+      Mode.color:=ScreenMode.Color;
+      Mode.col:=x;
+      Mode.row:=y;
+      SetScreenVideoMode(Mode);
+      Redraw;
+    end;
+end;
 
 {***************************************************************************}
 {                            INTERFACE ROUTINES                             }