Changeset 216 for branches

Timestamp:

May 10, 2020, 11:45:09 PM (5 years ago)

Author:

chronos

Message:

• Modified: Improved main form close and application termination support.

Location:

branches/highdpi

Files:

• LocalPlayer/MessgEx.pas (modified) (1 diff)
• Packages/DpiControls/UDpiControls.pas (modified) (31 diffs)

branches/highdpi/LocalPlayer/MessgEx.pas

@@ -291 +291 @@
 
   // paint
+  // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it
+  LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height);
   DpiBitCanvas(LogoBuffer.Canvas, 0, 0, wb, hb, ca, x, y);
 

branches/highdpi/Packages/DpiControls/UDpiControls.pas

@@ -208 +208 @@
     procedure Repaint;
     procedure Update;
+    function IsParentOf(AControl: TDpiControl): boolean; virtual;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
@@ -435 +436 @@
   private
     FOnActivate: TNotifyEvent;
+    FOnClose: TCloseEvent;
+    FOnCloseQuery: TCloseQueryEvent;
     FOnDeactivate: TNotifyEvent;
     function GetBorderIcons: TBorderIcons;
@@ -444 +447 @@
     function GetLCLVersion: string;
     function GetModalResult: TModalResult;
-    function GetOnClose: TCloseEvent;
     function GetOnCloseQuery: TCloseQueryEvent;
     function GetOnCreate: TNotifyEvent;
@@ -460 +462 @@
     procedure SetLCLVersion(AValue: string);
     procedure SetModalResult(AValue: TModalResult);
-    procedure SetOnClose(AValue: TCloseEvent);
     procedure SetOnCloseQuery(AValue: TCloseQueryEvent);
     procedure SetOnCreate(AValue: TNotifyEvent);
@@ -473 +474 @@
     procedure ActivateHandler(Sender: TObject);
     procedure DeactivateHandler(Sender: TObject);
+    procedure DoClose(var CloseAction: TCloseAction); virtual;
+    procedure CloseHandler(Sender: TObject; var CloseAction: TCloseAction);
+    procedure CloseQueryHandler(Sender : TObject; var CanClose : boolean);
   protected
     procedure CreateParams(var p: TCreateParams); virtual;
@@ -485 +489 @@
     function ShowModal: Integer; virtual;
     procedure Close;
+    function CloseQuery: boolean; virtual;
     procedure BringToFront;
+    procedure Release;
     constructor Create(TheOwner: TComponent); override;
     constructor CreateNew(AOwner: TComponent; Num: Integer = 0); virtual;
@@ -505 +511 @@
     property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
     property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
-    property OnClose: TCloseEvent read GetOnClose write SetOnClose;
-    property OnCloseQuery: TCloseQueryEvent read GetOnCloseQuery write SetOnCloseQuery;
+    property OnClose: TCloseEvent read FOnClose write FOnClose;
+    property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
     property ClientHeight;
     property ClientWidth;
@@ -691 +697 @@
     // TScreen
     FDpi: Integer;
+    FActiveFormPrev: TDpiForm;
     FActiveForm: TDpiForm;
+    FPrevActiveForms: TDpiForms;
     FForms: TDpiForms;
     procedure AddForm(AForm: TDpiForm);
@@ -702 +710 @@
     function GetHeight: Integer;
     function GetWidth: Integer;
-    procedure SetActiveForm(AValue: TDpiForm);
     procedure SetCursor(AValue: TCursor);
     procedure SetCursors(Index: Integer; AValue: HCURSOR);
@@ -711 +718 @@
     destructor Destroy; override;
     procedure UpdateScreen;
+    procedure UpdateActiveFormFromVclScreen;
     property FormCount: Integer read GetFormCount;
     property Forms[Index: Integer]: TDpiForm read GetForms;
-    property ActiveForm: TDpiForm read GetActiveForm write SetActiveForm;
+    property ActiveForm: TDpiForm read GetActiveForm;
     property Cursor: TCursor read GetCursor write SetCursor;
     property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors;
@@ -762 +770 @@
   public
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
     procedure Run;
     procedure Initialize;
+    procedure Terminate;
     procedure ProcessMessages;
     procedure UpdateMainForm(AForm: TDpiForm);
@@ -782 +792 @@
     procedure SetCursorPos(AValue: TPoint);
   public
+    constructor Create;
     property CursorPos: TPoint read GetCursorPos write SetCursorPos;
   end;
@@ -900 +911 @@
 end;
 
+constructor TDpiMouse.Create;
+begin
+
+end;
+
 { TDpiSizeConstraints }
 
@@ -1034 +1050 @@
 end;
 
+destructor TDpiApplication.Destroy;
+begin
+  inherited Destroy;
+end;
+
 procedure TDpiApplication.Run;
 begin
@@ -1044 +1065 @@
   GetVclApplication.Initialize;
   DpiScreen.UpdateScreen;
+end;
+
+procedure TDpiApplication.Terminate;
+begin
+  Application.Terminate;
 end;
 
@@ -2103 +2129 @@
 end;
 
-procedure TDpiScreen.SetActiveForm(AValue: TDpiForm);
-begin
-  FActiveForm := AValue;
-end;
-
 procedure TDpiScreen.SetCursor(AValue: TCursor);
 begin
@@ -2144 +2165 @@
 begin
   FForms.Remove(AForm);
-  if AForm = FActiveForm then FActiveForm := nil;
+  if AForm = FActiveForm then begin
+    FActiveFormPrev := FActiveForm;
+    FActiveForm := nil;
+  end;
 end;
 
@@ -2174 +2198 @@
   FForms := TDpiForms.Create;
   FForms.FreeObjects := False;
+  FPrevActiveForms := TDpiForms.Create;
+  FPrevActiveForms.FreeObjects := False;
   // Screen.PixelsPerInch is not initialized at this point
   Dpi := 96;
@@ -2181 +2207 @@
 begin
   FreeAndNil(FForms);
+  FreeAndNil(FPrevActiveForms);
   inherited Destroy;
 end;
@@ -2186 +2213 @@
 procedure TDpiScreen.UpdateScreen;
 begin
-  Dpi := Screen.PixelsPerInch;
+  Dpi := 96 * 2; //Screen.PixelsPerInch;
+end;
+
+procedure TDpiScreen.UpdateActiveFormFromVclScreen;
+var
+  I: Integer;
+  F: TDpiForm;
+begin
+  if Screen.ActiveForm = nil then FActiveForm := nil
+  else begin
+    for I := 0 to FormCount - 1 do begin
+      F := Forms[I];
+      if F.GetVclForm = Screen.ActiveForm then begin
+        FActiveForm := F;
+        Break;
+      end;
+    end;
+  end;
 end;
 
@@ -2366 +2410 @@
 end;
 
+function TDpiControl.IsParentOf(AControl: TDpiControl): boolean;
+begin
+  Result := False;
+  while Assigned(AControl) do
+  begin
+    AControl := AControl.Parent;
+    if Self = AControl then
+      Exit(True);
+  end;
+end;
+
 constructor TDpiControl.Create(TheOwner: TComponent);
 begin
@@ -2672 +2727 @@
 end;
 
-function TDpiForm.GetOnClose: TCloseEvent;
-begin
-  Result := GetVclForm.OnClose;
-end;
-
 function TDpiForm.GetOnCloseQuery: TCloseQueryEvent;
 begin
@@ -2750 +2800 @@
 begin
   GetVclForm.ModalResult := AValue;
-end;
-
-procedure TDpiForm.SetOnClose(AValue: TCloseEvent);
-begin
-  GetVclForm.OnClose := AValue;
 end;
 
@@ -2810 +2855 @@
 procedure TDpiForm.ActivateHandler(Sender: TObject);
 begin
-  DpiScreen.ActiveForm := Self;
+  DpiScreen.FActiveFormPrev := DpiScreen.FActiveForm;
+  DpiScreen.FActiveForm := Self;
   if Assigned(FOnActivate) then FOnActivate(Sender);
 end;
@@ -2816 +2862 @@
 procedure TDpiForm.DeactivateHandler(Sender: TObject);
 begin
+  DpiScreen.FActiveForm := DpiScreen.FActiveFormPrev;
+  //DpiScreen.UpdateActiveFormFromVclScreen;
   if Assigned(FOnDeactivate) then FOnDeactivate(Sender);
+end;
+
+procedure TDpiForm.DoClose(var CloseAction: TCloseAction);
+begin
+  if Assigned(FOnClose) then FOnClose(Self, CloseAction);
+end;
+
+procedure TDpiForm.CloseHandler(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  DoClose(CloseAction);
+end;
+
+procedure TDpiForm.CloseQueryHandler(Sender : TObject; var CanClose : boolean);
+begin
+  if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, CanClose);
 end;
 
@@ -2860 +2923 @@
   GetVclForm.OnActivate := @ActivateHandler;
   GetVclForm.OnDeactivate := @DeactivateHandler;
+  GetVclForm.OnClose := @CloseHandler;
+  GetVclForm.OnCloseQuery := @CloseQueryHandler;
+  GetVclForm.Name := Name + 'Vcl';
 end;
 
@@ -2874 +2940 @@
 
 procedure TDpiForm.Close;
-begin
-  GetVclForm.Close;
+var
+  CloseAction: TCloseAction;
+  IsMainForm: Boolean;
+begin
+  if fsModal in FormState then
+    ModalResult := mrCancel
+  else
+  begin
+    if CloseQuery then
+    begin
+      // IsMainForm flag set if we are closing MainForm or its parent
+      IsMainForm := (DpiApplication.MainForm = Self) or (Self.IsParentOf(DpiApplication.MainForm));
+      // Prepare default close action
+      if FormStyle = fsMDIChild then
+      begin
+        CloseAction := caNone;
+        // TODO: mdi logic
+      end
+      else
+      begin
+        if IsMainForm then
+          CloseAction := caFree
+        else
+          CloseAction := caHide;
+      end;
+      // call event handler and let user modify CloseAction
+      DoClose(CloseAction);
+      // execute action according to close action
+      case CloseAction of
+        caHide: Hide;
+        caMinimize: WindowState := wsMinimized;
+        caFree:
+          begin
+            // if form is MainForm, then terminate the application
+            // the owner of the MainForm is the application,
+            // so the Application will take care of free-ing the form
+            // and Release is not necessary
+            if IsMainForm then
+              DpiApplication.Terminate
+            else
+              Release;
+          end;
+      end;
+    end;
+  end;
+end;
+
+function TDpiForm.CloseQuery: boolean;
+begin
+  Result := True;
+  if Assigned(FOnCloseQuery) then
+    FOnCloseQuery(Self, Result);
 end;
 
@@ -2881 +2997 @@
 begin
   GetVclForm.BringToFront;
+end;
+
+procedure TDpiForm.Release;
+begin
+  Free;
 end;
 
@@ -2911 +3032 @@
 destructor TDpiForm.Destroy;
 begin
-  FreeAndNil(VclForm);
+  // TODO: Can't destroy directly?
+  //FreeAndNil(VclForm);
   DpiScreen.RemoveForm(Self);
 end;
@@ -2923 +3045 @@
 DpiScreen := TDpiScreen.Create;
 DpiApplication := TDpiApplication.Create(nil);
+DpiMouse := TDpiMouse.Create;
 RegisterClasses([TDpiButton, TDpiImage, TDpiPaintBox, TDpiListBox]);
 
@@ -2929 +3052 @@
 FreeAndNil(DpiApplication);
 FreeAndNil(DpiScreen);
+FreeAndNil(DpiMouse);
 
 end.