Changeset 216


Ignore:
Timestamp:
May 10, 2020, 11:45:09 PM (18 months ago)
Author:
chronos
Message:
  • Modified: Improved main form close and application termination support.
Location:
branches/highdpi
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/highdpi/LocalPlayer/MessgEx.pas

    r210 r216  
    291291
    292292  // paint
     293  // TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it
     294  LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height);
    293295  DpiBitCanvas(LogoBuffer.Canvas, 0, 0, wb, hb, ca, x, y);
    294296
  • branches/highdpi/Packages/DpiControls/UDpiControls.pas

    r214 r216  
    208208    procedure Repaint;
    209209    procedure Update;
     210    function IsParentOf(AControl: TDpiControl): boolean; virtual;
    210211    constructor Create(TheOwner: TComponent); override;
    211212    destructor Destroy; override;
     
    435436  private
    436437    FOnActivate: TNotifyEvent;
     438    FOnClose: TCloseEvent;
     439    FOnCloseQuery: TCloseQueryEvent;
    437440    FOnDeactivate: TNotifyEvent;
    438441    function GetBorderIcons: TBorderIcons;
     
    444447    function GetLCLVersion: string;
    445448    function GetModalResult: TModalResult;
    446     function GetOnClose: TCloseEvent;
    447449    function GetOnCloseQuery: TCloseQueryEvent;
    448450    function GetOnCreate: TNotifyEvent;
     
    460462    procedure SetLCLVersion(AValue: string);
    461463    procedure SetModalResult(AValue: TModalResult);
    462     procedure SetOnClose(AValue: TCloseEvent);
    463464    procedure SetOnCloseQuery(AValue: TCloseQueryEvent);
    464465    procedure SetOnCreate(AValue: TNotifyEvent);
     
    473474    procedure ActivateHandler(Sender: TObject);
    474475    procedure DeactivateHandler(Sender: TObject);
     476    procedure DoClose(var CloseAction: TCloseAction); virtual;
     477    procedure CloseHandler(Sender: TObject; var CloseAction: TCloseAction);
     478    procedure CloseQueryHandler(Sender : TObject; var CanClose : boolean);
    475479  protected
    476480    procedure CreateParams(var p: TCreateParams); virtual;
     
    485489    function ShowModal: Integer; virtual;
    486490    procedure Close;
     491    function CloseQuery: boolean; virtual;
    487492    procedure BringToFront;
     493    procedure Release;
    488494    constructor Create(TheOwner: TComponent); override;
    489495    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); virtual;
     
    505511    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    506512    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    507     property OnClose: TCloseEvent read GetOnClose write SetOnClose;
    508     property OnCloseQuery: TCloseQueryEvent read GetOnCloseQuery write SetOnCloseQuery;
     513    property OnClose: TCloseEvent read FOnClose write FOnClose;
     514    property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
    509515    property ClientHeight;
    510516    property ClientWidth;
     
    691697    // TScreen
    692698    FDpi: Integer;
     699    FActiveFormPrev: TDpiForm;
    693700    FActiveForm: TDpiForm;
     701    FPrevActiveForms: TDpiForms;
    694702    FForms: TDpiForms;
    695703    procedure AddForm(AForm: TDpiForm);
     
    702710    function GetHeight: Integer;
    703711    function GetWidth: Integer;
    704     procedure SetActiveForm(AValue: TDpiForm);
    705712    procedure SetCursor(AValue: TCursor);
    706713    procedure SetCursors(Index: Integer; AValue: HCURSOR);
     
    711718    destructor Destroy; override;
    712719    procedure UpdateScreen;
     720    procedure UpdateActiveFormFromVclScreen;
    713721    property FormCount: Integer read GetFormCount;
    714722    property Forms[Index: Integer]: TDpiForm read GetForms;
    715     property ActiveForm: TDpiForm read GetActiveForm write SetActiveForm;
     723    property ActiveForm: TDpiForm read GetActiveForm;
    716724    property Cursor: TCursor read GetCursor write SetCursor;
    717725    property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors;
     
    762770  public
    763771    constructor Create(AOwner: TComponent); override;
     772    destructor Destroy; override;
    764773    procedure Run;
    765774    procedure Initialize;
     775    procedure Terminate;
    766776    procedure ProcessMessages;
    767777    procedure UpdateMainForm(AForm: TDpiForm);
     
    782792    procedure SetCursorPos(AValue: TPoint);
    783793  public
     794    constructor Create;
    784795    property CursorPos: TPoint read GetCursorPos write SetCursorPos;
    785796  end;
     
    900911end;
    901912
     913constructor TDpiMouse.Create;
     914begin
     915
     916end;
     917
    902918{ TDpiSizeConstraints }
    903919
     
    10341050end;
    10351051
     1052destructor TDpiApplication.Destroy;
     1053begin
     1054  inherited Destroy;
     1055end;
     1056
    10361057procedure TDpiApplication.Run;
    10371058begin
     
    10441065  GetVclApplication.Initialize;
    10451066  DpiScreen.UpdateScreen;
     1067end;
     1068
     1069procedure TDpiApplication.Terminate;
     1070begin
     1071  Application.Terminate;
    10461072end;
    10471073
     
    21032129end;
    21042130
    2105 procedure TDpiScreen.SetActiveForm(AValue: TDpiForm);
    2106 begin
    2107   FActiveForm := AValue;
    2108 end;
    2109 
    21102131procedure TDpiScreen.SetCursor(AValue: TCursor);
    21112132begin
     
    21442165begin
    21452166  FForms.Remove(AForm);
    2146   if AForm = FActiveForm then FActiveForm := nil;
     2167  if AForm = FActiveForm then begin
     2168    FActiveFormPrev := FActiveForm;
     2169    FActiveForm := nil;
     2170  end;
    21472171end;
    21482172
     
    21742198  FForms := TDpiForms.Create;
    21752199  FForms.FreeObjects := False;
     2200  FPrevActiveForms := TDpiForms.Create;
     2201  FPrevActiveForms.FreeObjects := False;
    21762202  // Screen.PixelsPerInch is not initialized at this point
    21772203  Dpi := 96;
     
    21812207begin
    21822208  FreeAndNil(FForms);
     2209  FreeAndNil(FPrevActiveForms);
    21832210  inherited Destroy;
    21842211end;
     
    21862213procedure TDpiScreen.UpdateScreen;
    21872214begin
    2188   Dpi := Screen.PixelsPerInch;
     2215  Dpi := 96 * 2; //Screen.PixelsPerInch;
     2216end;
     2217
     2218procedure TDpiScreen.UpdateActiveFormFromVclScreen;
     2219var
     2220  I: Integer;
     2221  F: TDpiForm;
     2222begin
     2223  if Screen.ActiveForm = nil then FActiveForm := nil
     2224  else begin
     2225    for I := 0 to FormCount - 1 do begin
     2226      F := Forms[I];
     2227      if F.GetVclForm = Screen.ActiveForm then begin
     2228        FActiveForm := F;
     2229        Break;
     2230      end;
     2231    end;
     2232  end;
    21892233end;
    21902234
     
    23662410end;
    23672411
     2412function TDpiControl.IsParentOf(AControl: TDpiControl): boolean;
     2413begin
     2414  Result := False;
     2415  while Assigned(AControl) do
     2416  begin
     2417    AControl := AControl.Parent;
     2418    if Self = AControl then
     2419      Exit(True);
     2420  end;
     2421end;
     2422
    23682423constructor TDpiControl.Create(TheOwner: TComponent);
    23692424begin
     
    26722727end;
    26732728
    2674 function TDpiForm.GetOnClose: TCloseEvent;
    2675 begin
    2676   Result := GetVclForm.OnClose;
    2677 end;
    2678 
    26792729function TDpiForm.GetOnCloseQuery: TCloseQueryEvent;
    26802730begin
     
    27502800begin
    27512801  GetVclForm.ModalResult := AValue;
    2752 end;
    2753 
    2754 procedure TDpiForm.SetOnClose(AValue: TCloseEvent);
    2755 begin
    2756   GetVclForm.OnClose := AValue;
    27572802end;
    27582803
     
    28102855procedure TDpiForm.ActivateHandler(Sender: TObject);
    28112856begin
    2812   DpiScreen.ActiveForm := Self;
     2857  DpiScreen.FActiveFormPrev := DpiScreen.FActiveForm;
     2858  DpiScreen.FActiveForm := Self;
    28132859  if Assigned(FOnActivate) then FOnActivate(Sender);
    28142860end;
     
    28162862procedure TDpiForm.DeactivateHandler(Sender: TObject);
    28172863begin
     2864  DpiScreen.FActiveForm := DpiScreen.FActiveFormPrev;
     2865  //DpiScreen.UpdateActiveFormFromVclScreen;
    28182866  if Assigned(FOnDeactivate) then FOnDeactivate(Sender);
     2867end;
     2868
     2869procedure TDpiForm.DoClose(var CloseAction: TCloseAction);
     2870begin
     2871  if Assigned(FOnClose) then FOnClose(Self, CloseAction);
     2872end;
     2873
     2874procedure TDpiForm.CloseHandler(Sender: TObject; var CloseAction: TCloseAction);
     2875begin
     2876  DoClose(CloseAction);
     2877end;
     2878
     2879procedure TDpiForm.CloseQueryHandler(Sender : TObject; var CanClose : boolean);
     2880begin
     2881  if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, CanClose);
    28192882end;
    28202883
     
    28602923  GetVclForm.OnActivate := @ActivateHandler;
    28612924  GetVclForm.OnDeactivate := @DeactivateHandler;
     2925  GetVclForm.OnClose := @CloseHandler;
     2926  GetVclForm.OnCloseQuery := @CloseQueryHandler;
     2927  GetVclForm.Name := Name + 'Vcl';
    28622928end;
    28632929
     
    28742940
    28752941procedure TDpiForm.Close;
    2876 begin
    2877   GetVclForm.Close;
     2942var
     2943  CloseAction: TCloseAction;
     2944  IsMainForm: Boolean;
     2945begin
     2946  if fsModal in FormState then
     2947    ModalResult := mrCancel
     2948  else
     2949  begin
     2950    if CloseQuery then
     2951    begin
     2952      // IsMainForm flag set if we are closing MainForm or its parent
     2953      IsMainForm := (DpiApplication.MainForm = Self) or (Self.IsParentOf(DpiApplication.MainForm));
     2954      // Prepare default close action
     2955      if FormStyle = fsMDIChild then
     2956      begin
     2957        CloseAction := caNone;
     2958        // TODO: mdi logic
     2959      end
     2960      else
     2961      begin
     2962        if IsMainForm then
     2963          CloseAction := caFree
     2964        else
     2965          CloseAction := caHide;
     2966      end;
     2967      // call event handler and let user modify CloseAction
     2968      DoClose(CloseAction);
     2969      // execute action according to close action
     2970      case CloseAction of
     2971        caHide: Hide;
     2972        caMinimize: WindowState := wsMinimized;
     2973        caFree:
     2974          begin
     2975            // if form is MainForm, then terminate the application
     2976            // the owner of the MainForm is the application,
     2977            // so the Application will take care of free-ing the form
     2978            // and Release is not necessary
     2979            if IsMainForm then
     2980              DpiApplication.Terminate
     2981            else
     2982              Release;
     2983          end;
     2984      end;
     2985    end;
     2986  end;
     2987end;
     2988
     2989function TDpiForm.CloseQuery: boolean;
     2990begin
     2991  Result := True;
     2992  if Assigned(FOnCloseQuery) then
     2993    FOnCloseQuery(Self, Result);
    28782994end;
    28792995
     
    28812997begin
    28822998  GetVclForm.BringToFront;
     2999end;
     3000
     3001procedure TDpiForm.Release;
     3002begin
     3003  Free;
    28833004end;
    28843005
     
    29113032destructor TDpiForm.Destroy;
    29123033begin
    2913   FreeAndNil(VclForm);
     3034  // TODO: Can't destroy directly?
     3035  //FreeAndNil(VclForm);
    29143036  DpiScreen.RemoveForm(Self);
    29153037end;
     
    29233045DpiScreen := TDpiScreen.Create;
    29243046DpiApplication := TDpiApplication.Create(nil);
     3047DpiMouse := TDpiMouse.Create;
    29253048RegisterClasses([TDpiButton, TDpiImage, TDpiPaintBox, TDpiListBox]);
    29263049
     
    29293052FreeAndNil(DpiApplication);
    29303053FreeAndNil(DpiScreen);
     3054FreeAndNil(DpiMouse);
    29313055
    29323056end.
Note: See TracChangeset for help on using the changeset viewer.