Changeset 534 for DpiControls/UDpiControls.pas

Timestamp:

May 26, 2019, 8:29:38 PM (5 years ago)

Author:

chronos

Message:

• Added: Update DpiForm position according real form position.

File:

• DpiControls/UDpiControls.pas (modified) (19 diffs)

DpiControls/UDpiControls.pas

@@ -46 +46 @@
   TDpiControl = class(TComponent)
   private
-    FCaption: string;
     FFont: TDpiFont;
     FHeight: Integer;
     FLeft: Integer;
+    FOnChangeBounds: TNotifyEvent;
+    FOnResize: TNotifyEvent;
     FTop: Integer;
     FVisible: Boolean;
@@ -55 +56 @@
     FParent: TDpiWinControl;
     procedure SetFont(AValue: TDpiFont);
+    procedure SetOnChangeBounds(AValue: TNotifyEvent);
+    procedure SetOnResize(AValue: TNotifyEvent);
+    procedure VclFormResize(Sender: TObject);
+    procedure VclChangeBounds(Sender: TObject);
+    procedure DoFormResize;
+    procedure DoChangeBounds;
   protected
     procedure UpdateBounds; virtual;
     procedure FontChanged(Sender: TObject); virtual;
+    function GetCaption: string; virtual;
     procedure SetParent(AValue: TDpiWinControl); virtual;
     procedure SetCaption(AValue: string); virtual;
@@ -66 +74 @@
     procedure SetWidth(AValue: Integer); virtual;
     function GetVclControl: TControl; virtual;
+    procedure UpdateVclControl; virtual;
   public
     procedure ScreenChanged; virtual;
@@ -71 +80 @@
     procedure Show;
     procedure Hide;
-    function Scale(Value: Integer): Integer;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
@@ -81 +89 @@
     property Height: Integer read FHeight write SetHeight;
     property Visible: Boolean read FVisible write SetVisible;
-    property Caption: string read FCaption write SetCaption;
+    property Caption: string read GetCaption write SetCaption;
     property Font: TDpiFont read FFont write SetFont;
+    property OnResize: TNotifyEvent read FOnResize write SetOnResize;
+    property OnChangeBounds: TNotifyEvent read FOnChangeBounds write SetOnChangeBounds;
   end;
 
@@ -105 +115 @@
   TDpiForm = class(TDpiWinControl)
   private
-    FOnShow: TNotifyEvent;
+    function GetOnCreate: TNotifyEvent;
+    function GetOnDestroy: TNotifyEvent;
+    function GetOnHide: TNotifyEvent;
+    function GetOnShow: TNotifyEvent;
+    procedure SetOnCreate(AValue: TNotifyEvent);
+    procedure SetOnDestroy(AValue: TNotifyEvent);
+    procedure SetOnHide(AValue: TNotifyEvent);
     procedure SetOnShow(AValue: TNotifyEvent);
+    procedure DoOnCreate;
   protected
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
@@ -116 +133 @@
     destructor Destroy; override;
   published
-    property OnShow: TNotifyEvent read FOnShow write SetOnShow;
+    property OnShow: TNotifyEvent read GetOnShow write SetOnShow;
+    property OnHide: TNotifyEvent read GetOnHide write SetOnHide;
+    property OnCreate: TNotifyEvent read GetOnCreate write SetOnCreate;
+    property OnDestroy: TNotifyEvent read GetOnDestroy write SetOnDestroy;
   end;
 
@@ -158 +178 @@
   private
     FDpi: Integer;
+    function GetHeight: Integer;
+    function GetWidth: Integer;
     procedure SetDpi(AValue: Integer);
     procedure UpdateForms;
@@ -166 +188 @@
   published
     property Dpi: Integer read FDpi write SetDpi;
+    property Width: Integer read GetWidth;
+    property Height: Integer read GetHeight;
   end;
 
@@ -189 +213 @@
 end;
 
+function ScaleToVcl(Value: Integer): Integer;
+begin
+  Result := Round(Value * DpiScreen.Dpi / 96);
+end;
+
+function ScaleFromVcl(Value: Integer): Integer;
+begin
+  Result := Round(Value * 96 / DpiScreen.Dpi);
+end;
+
+
 { TDpiImage }
 
@@ -290 +325 @@
 end;
 
+function TDpiScreen.GetWidth: Integer;
+begin
+  Result := ScaleFromVcl(Screen.Width);
+end;
+
+function TDpiScreen.GetHeight: Integer;
+begin
+  Result := ScaleFromVcl(Screen.Height);
+end;
+
 procedure TDpiScreen.UpdateForms;
 var
@@ -354 +399 @@
   if FVisible = AValue then Exit;
   FVisible := AValue;
-  GetVclControl.Visible := AValue;;
+  GetVclControl.Visible := AValue;
 end;
 
@@ -367 +412 @@
 begin
   Result := nil;
+end;
+
+procedure TDpiControl.UpdateVclControl;
+begin
+  GetVclControl.OnResize := @VclFormResize;
+  GetVclControl.OnChangeBounds := @VclChangeBounds;
 end;
 
@@ -394 +445 @@
 end;
 
-function TDpiControl.Scale(Value: Integer): Integer;
-begin
-  Scale := Round(Value * DpiScreen.Dpi / 96);
-end;
-
 constructor TDpiControl.Create(TheOwner: TComponent);
 begin
@@ -421 +467 @@
 procedure TDpiControl.SetCaption(AValue: string);
 begin
-  if FCaption = AValue then Exit;
-  FCaption := AValue;
   GetVclControl.Caption := AValue;
 end;
@@ -448 +492 @@
 end;
 
+procedure TDpiControl.SetOnChangeBounds(AValue: TNotifyEvent);
+begin
+  if FOnChangeBounds = AValue then Exit;
+  FOnChangeBounds := AValue;
+end;
+
+procedure TDpiControl.SetOnResize(AValue: TNotifyEvent);
+begin
+  if FOnResize = AValue then Exit;
+  FOnResize := AValue;
+end;
+
+procedure TDpiControl.VclFormResize(Sender: TObject);
+begin
+  SetBounds(ScaleFromVcl(GetVclControl.Left), ScaleFromVcl(GetVclControl.Top),
+    ScaleFromVcl(GetVclControl.Width), ScaleFromVcl(GetVclControl.Height));
+  DoFormResize;
+end;
+
+procedure TDpiControl.VclChangeBounds(Sender: TObject);
+begin
+  SetBounds(ScaleFromVcl(GetVclControl.Left), ScaleFromVcl(GetVclControl.Top),
+    ScaleFromVcl(GetVclControl.Width), ScaleFromVcl(GetVclControl.Height));
+  DoChangeBounds;
+end;
+
+procedure TDpiControl.DoFormResize;
+begin
+  if Assigned(FOnResize) then FOnResize(Self);
+end;
+
+procedure TDpiControl.DoChangeBounds;
+begin
+  if Assigned(FOnChangeBounds) then FOnChangeBounds(Self);
+end;
+
+function TDpiControl.GetCaption: string;
+begin
+  Result := GetVclControl.Caption;
+end;
+
 procedure TDpiControl.FontChanged(Sender: TObject);
 begin
-  GetVclControl.Font.Size := Scale(Font.Size);
+  GetVclControl.Font.Size := ScaleToVcl(Font.Size);
 end;
 
 procedure TDpiControl.UpdateBounds;
 begin
-  GetVclControl.SetBounds(Scale(Left), Scale(Top), Scale(Width), Scale(Height));
+  GetVclControl.SetBounds(ScaleToVcl(Left), ScaleToVcl(Top), ScaleToVcl(Width), ScaleToVcl(Height));
 end;
 
@@ -492 +577 @@
 
 { TDpiForm }
+
+function TDpiForm.GetOnCreate: TNotifyEvent;
+begin
+  Result := VclForm.OnCreate;
+end;
+
+function TDpiForm.GetOnDestroy: TNotifyEvent;
+begin
+  Result := VclForm.OnDestroy;
+end;
+
+function TDpiForm.GetOnHide: TNotifyEvent;
+begin
+  Result := VclForm.OnHide;
+end;
+
+function TDpiForm.GetOnShow: TNotifyEvent;
+begin
+  Result := VclForm.OnShow;
+end;
+
+procedure TDpiForm.SetOnCreate(AValue: TNotifyEvent);
+begin
+  VclForm.OnCreate := AValue;
+end;
+
+procedure TDpiForm.SetOnDestroy(AValue: TNotifyEvent);
+begin
+  VclForm.OnDestroy := AValue;
+end;
+
+procedure TDpiForm.SetOnHide(AValue: TNotifyEvent);
+begin
+  VclForm.OnHide := AValue;
+end;
+
+procedure TDpiForm.SetOnShow(AValue: TNotifyEvent);
+begin
+  VclForm.OnShow := AValue;
+end;
+
+procedure TDpiForm.DoOnCreate;
+begin
+  if Assigned(VclForm.OnCreate) then
+    VclForm.OnCreate(Self);
+end;
 
 // This method is called by TWriter to retrieve the child components to write
@@ -517 +648 @@
 begin
   Result := VclForm;
-end;
-
-procedure TDpiForm.SetOnShow(AValue: TNotifyEvent);
-begin
-  if FOnShow = AValue then Exit;
-  FOnShow := AValue;
-  VclForm.OnShow := AValue;
 end;
 
@@ -544 +668 @@
     GlobalNameSpace.EndWrite;
   end;
+  UpdateVclControl;
+  DoOnCreate;
 end;