Changeset 534

Timestamp:

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

Author:

chronos

Message:

• Added: Update DpiForm position according real form position.

Location:

DpiControls

Files:

• Demo/DpiComponentsDemo.lpi (modified) (1 diff)
• Demo/DpiComponentsDemo.lpr (modified) (1 diff)
• Demo/UDpiFormMain.lfm (moved) (moved from DpiControls/Demo/UDpiForm.lfm ) (2 diffs)
• Demo/UDpiFormMain.pas (moved) (moved from DpiControls/Demo/UDpiForm.pas ) (6 diffs)
• Demo/UFormMain.lfm (modified) (2 diffs)
• Demo/UFormMain.pas (modified) (3 diffs)
• UDpiControls.pas (modified) (19 diffs)

DpiControls/Demo/DpiComponentsDemo.lpi

@@ -48 +48 @@
       </Unit1>
       <Unit2>
-        <Filename Value="UDpiForm.pas"/>
+        <Filename Value="UDpiFormMain.pas"/>
         <IsPartOfProject Value="True"/>
-        <ComponentName Value="DpiForm1"/>
+        <ComponentName Value="DpiFormMain"/>
         <HasResources Value="True"/>
       </Unit2>

DpiControls/Demo/DpiComponentsDemo.lpr

@@ -8 +8 @@
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, UFormMain, UDpiForm
+  Forms, UFormMain, UDpiFormMain
   { you can add units after this };
 

DpiControls/Demo/UDpiFormMain.lfm

@@ -1 @@
-object DpiForm1: TDpiForm1
+object DpiFormMain: TDpiFormMain
   Top = 504
   Left = 865
   Width = 0
   Height = 0
-  Visible = False
-  OnShow = DpiForm1Show
+  Visible = True
+  OnCreate = DpiFormMainCreate
   object DpiButton1: TDpiButton
-    Top = 154
-    Left = 20
+    Top = 128
+    Left = 8
     Width = 150
     Height = 40
@@ -14 +14 @@
     Caption = 'Test'
     OnClick = DpiButton1Click
-    left = 88
-    top = 88
   end
 end

DpiControls/Demo/UDpiFormMain.pas

@@ -1 @@
-unit UDpiForm;
+unit UDpiFormMain;
 
 {$mode objfpc}{$H+}
@@ -10 +10 @@
 type
 
-  { TDpiForm1 }
+  { TDpiFormMain }
 
-  TDpiForm1 = class(TDpiForm)
+  TDpiFormMain = class(TDpiForm)
     DpiButton1: TDpiButton;
     procedure DpiButton1Click(Sender: TObject);
-    procedure DpiForm1Show(Sender: TObject);
+    procedure DpiFormMainCreate(Sender: TObject);
   private
 
@@ -23 +23 @@
 
 var
-  DpiForm1: TDpiForm1;
+  DpiFormMain: TDpiFormMain;
 
 implementation
@@ -29 +29 @@
 {$R *.lfm}
 
-{ TDpiForm1 }
+{ TDpiFormMain }
 
-procedure TDpiForm1.DpiForm1Show(Sender: TObject);
+procedure TDpiFormMain.DpiFormMainCreate(Sender: TObject);
 var
   DpiButton: TDpiButton;
   DpiImage: TDpiImage;
 begin
-  DpiButton := TDpiButton.Create(DpiForm1);
-  DpiButton.Parent := DpiForm1;
+  DpiButton := TDpiButton.Create(DpiFormMain);
+  DpiButton.Parent := Self;
   DpiButton.SetBounds(10, 10, 100, 30);
   DpiButton.Caption := 'Click me';
@@ -43 +43 @@
   DpiButton1.Parent := Self;
 
-  DpiImage := TDpiImage.Create(DpiForm1);
-  DpiImage.Parent := DpiForm1;
+  DpiImage := TDpiImage.Create(DpiFormMain);
+  DpiImage.Parent := Self;
   DpiImage.SetBounds(150, 10, 100, 100);
   DpiImage.Visible := True;
@@ -51 +51 @@
 end;
 
-procedure TDpiForm1.DpiButton1Click(Sender: TObject);
+procedure TDpiFormMain.DpiButton1Click(Sender: TObject);
 begin
   ShowMessage('Hello');

DpiControls/Demo/UFormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
-  Left = 57
-  Height = 126
-  Top = 44
+  Left = 127
+  Height = 168
+  Top = 66
   Width = 472
   Caption = 'DpiControls demo'
-  ClientHeight = 126
+  ClientHeight = 168
   ClientWidth = 472
   DesignTimePPI = 144
@@ -29 +29 @@
     ParentColor = False
   end
+  object ButtonNewDpiForm: TButton
+    Left = 19
+    Height = 38
+    Top = 117
+    Width = 193
+    Caption = 'New DpiForm'
+    OnClick = ButtonNewDpiFormClick
+    TabOrder = 1
+  end
 end

DpiControls/Demo/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
-  ExtCtrls, UDpiForm, UDpiControls;
+  ExtCtrls, UDpiControls, UDpiFormMain;
 
 type
@@ -14 +14 @@
 
   TFormMain = class(TForm)
+    ButtonNewDpiForm: TButton;
     Label1: TLabel;
     TrackBar1: TTrackBar;
+    procedure ButtonNewDpiFormClick(Sender: TObject);
     procedure FormShow(Sender: TObject);
     procedure TrackBar1Change(Sender: TObject);
@@ -37 +39 @@
   DpiScreen.Dpi := 96 * 2;
   TrackBar1.Position := DpiScreen.Dpi;
+  ButtonNewDpiFormClick(nil);
+end;
 
-  DpiForm1 := TDpiForm1.Create(nil);
-  DpiForm1.Caption := DpiForm1.Name;
-  DpiForm1.SetBounds(100, 100, 400, 200);
-  DpiForm1.Show;
-
-  DpiScreen.Forms.Add(DpiForm1);
+procedure TFormMain.ButtonNewDpiFormClick(Sender: TObject);
+var
+  DpiForm: TDpiForm;
+begin
+  DpiForm := TDpiFormMain.Create(nil);
+  DpiForm.Caption := DpiForm.Name;
+  DpiForm.SetBounds(100, 100, 400, 200);
+  DpiForm.Show;
+  DpiScreen.Forms.Add(DpiForm);
 end;
 

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;