Changeset 533 for DpiControls

Timestamp:

May 26, 2019, 7:33:14 PM (5 years ago)

Author:

chronos

Message:

• Added: TDpiImage control.

Location:

DpiControls

Files:

• . (modified) (1 prop)
• Demo (modified) (1 prop)
• Demo/DpiComponentsDemo.lpi (modified) (2 diffs)
• Demo/DpiComponentsDemo.lpr (modified) (1 diff)
• Demo/UDpiForm.lfm (modified) (2 diffs)
• Demo/UDpiForm.pas (modified) (2 diffs)
• Demo/UFormMain.lfm (modified) (2 diffs)
• Demo/UFormMain.pas (modified) (4 diffs)
• Demo/dance.jpg (added)
• UDpiControls.pas (modified) (19 diffs)

DpiControls/Demo/DpiComponentsDemo.lpi

@@ -43 +43 @@
         <Filename Value="UFormMain.pas"/>
         <IsPartOfProject Value="True"/>
-        <ComponentName Value="Form1"/>
+        <ComponentName Value="FormMain"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
@@ -62 +62 @@
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-${BuildMode}"/>
     </SearchPaths>
     <Linking>

DpiControls/Demo/DpiComponentsDemo.lpr

@@ -17 +17 @@
   Application.Scaled:=True;
   Application.Initialize;
-  Application.CreateForm(TForm1, Form1);
+  Application.CreateForm(TFormMain, FormMain);
   Application.Run;
 end.

DpiControls/Demo/UDpiForm.lfm

@@ -7 +7 @@
   OnShow = DpiForm1Show
   object DpiButton1: TDpiButton
-    Top = 104
-    Left = 120
+    Top = 154
+    Left = 20
     Width = 150
     Height = 40
@@ -14 +14 @@
     Caption = 'Test'
     OnClick = DpiButton1Click
+    left = 88
+    top = 88
   end
 end

DpiControls/Demo/UDpiForm.pas

@@ -34 +34 @@
 var
   DpiButton: TDpiButton;
+  DpiImage: TDpiImage;
 begin
   DpiButton := TDpiButton.Create(DpiForm1);
@@ -41 +42 @@
   DpiButton.Visible := True;
   DpiButton1.Parent := Self;
+
+  DpiImage := TDpiImage.Create(DpiForm1);
+  DpiImage.Parent := DpiForm1;
+  DpiImage.SetBounds(150, 10, 100, 100);
+  DpiImage.Visible := True;
+  DpiImage.Stretch := True;
+  DpiImage.VclImage.Picture.LoadFromFile('dance.jpg');
 end;
 

DpiControls/Demo/UFormMain.lfm

@@ -1 @@
-object Form1: TForm1
-  Left = 837
-  Height = 360
-  Top = 45
-  Width = 480
-  Caption = 'Form1'
-  ClientHeight = 360
-  ClientWidth = 480
+object FormMain: TFormMain
+  Left = 57
+  Height = 126
+  Top = 44
+  Width = 472
+  Caption = 'DpiControls demo'
+  ClientHeight = 126
+  ClientWidth = 472
   DesignTimePPI = 144
   OnShow = FormShow
   LCLVersion = '2.0.2.0'
   object TrackBar1: TTrackBar
-    Left = 24
+    Left = 13
     Height = 58
-    Top = 102
-    Width = 416
+    Top = 40
+    Width = 440
     Max = 1000
     Min = 96
@@ -21 +21 @@
     TabOrder = 0
   end
+  object Label1: TLabel
+    Left = 13
+    Height = 26
+    Top = 8
+    Width = 35
+    Caption = 'DPI:'
+    ParentColor = False
+  end
 end

DpiControls/Demo/UFormMain.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, UDpiForm,
-  UDpiControls;
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
+  ExtCtrls, UDpiForm, UDpiControls;
 
 type
 
-  { TForm1 }
+  { TFormMain }
 
-  TForm1 = class(TForm)
+  TFormMain = class(TForm)
+    Label1: TLabel;
     TrackBar1: TTrackBar;
     procedure FormShow(Sender: TObject);
@@ -24 +25 @@
 
 var
-  Form1: TForm1;
+  FormMain: TFormMain;
 
 implementation
@@ -30 +31 @@
 {$R *.lfm}
 
-{ TForm1 }
+{ TFormMain }
 
-procedure TForm1.FormShow(Sender: TObject);
+procedure TFormMain.FormShow(Sender: TObject);
 begin
   DpiScreen.Dpi := 96 * 2;
@@ -45 +46 @@
 end;
 
-procedure TForm1.TrackBar1Change(Sender: TObject);
+procedure TFormMain.TrackBar1Change(Sender: TObject);
 begin
   DpiScreen.Dpi := TrackBar1.Position;

DpiControls/UDpiControls.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
-  Controls, StdCtrls, fgl, Graphics;
+  Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls;
 
 type
@@ -29 +29 @@
     procedure SetSize(AValue: Integer);
     procedure DoChange;
+  protected
+    procedure ScreenChanged;
   public
     VclFont: TFont;
@@ -63 +65 @@
     procedure SetVisible(AValue: Boolean); virtual;
     procedure SetWidth(AValue: Integer); virtual;
+    function GetVclControl: TControl; virtual;
   public
     procedure ScreenChanged; virtual;
@@ -88 +91 @@
   TDpiWinControl = class(TDpiControl)
   private
+  protected
+    function GetVclWinControl: TWinControl; virtual;
   public
     Controls: TDpiControls;
@@ -103 +108 @@
     procedure SetOnShow(AValue: TNotifyEvent);
   protected
-    procedure FontChanged(Sender: TObject); override;
-    procedure UpdateBounds; override;
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
-    procedure SetVisible(AValue: Boolean); override;
-    procedure SetCaption(AValue: string); override;
+    function GetVclControl: TControl; override;
+    function GetVclWinControl: TWinControl; override;
   public
     VclForm: TForm;
@@ -125 +128 @@
     procedure SetOnClick(AValue: TNotifyEvent);
   protected
-    procedure FontChanged(Sender: TObject); override;
-    procedure UpdateBounds; override;
-    procedure SetVisible(AValue: Boolean); override;
-    procedure SetCaption(AValue: string); override;
-    procedure SetParent(AValue: TDpiWinControl); override;
+    function GetVclControl: TControl; override;
   public
     VclButton: TButton;
@@ -136 +135 @@
   published
     property OnClick: TNotifyEvent read FOnClick write SetOnClick;
+  end;
+
+  { TDpiImage }
+
+  TDpiImage = class(TDpiControl)
+  private
+    FStretch: Boolean;
+    procedure SetStretch(AValue: Boolean);
+  protected
+  public
+    VclImage: TImage;
+    function GetVclControl: TControl; override;
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property Stretch: Boolean read FStretch write SetStretch;
   end;
 
@@ -171 +186 @@
   DpiFormFileDesc := TDpiFormFileDesc.Create;
   RegisterProjectFileDescriptor(DpiFormFileDesc);
-  RegisterComponents('DpiControls', [TDpiButton]);
+  RegisterComponents('DpiControls', [TDpiButton, TDpiImage]);
+end;
+
+{ TDpiImage }
+
+procedure TDpiImage.SetStretch(AValue: Boolean);
+begin
+  if FStretch = AValue then Exit;
+  FStretch := AValue;
+  VclImage.Stretch := AValue;
+end;
+
+function TDpiImage.GetVclControl: TControl;
+begin
+  Result := VclImage;
+end;
+
+constructor TDpiImage.Create(TheOwner: TComponent);
+begin
+  inherited;
+  VclImage := TImage.Create(nil);
+end;
+
+destructor TDpiImage.Destroy;
+begin
+  FreeAndNil(VclImage);
+  inherited Destroy;
 end;
 
@@ -188 +229 @@
 end;
 
+procedure TDpiFont.ScreenChanged;
+begin
+  DoChange;
+end;
+
 procedure TDpiFont.SetOnChange(AValue: TNotifyEvent);
 begin
@@ -207 +253 @@
 
 { TDpiWinControl }
+
+function TDpiWinControl.GetVclWinControl: TWinControl;
+begin
+  Result := nil;
+end;
 
 procedure TDpiWinControl.ScreenChanged;
@@ -272 +323 @@
 end;
 
-procedure TDpiButton.FontChanged(Sender: TObject);
-begin
-  inherited;
-  VclButton.Font.Size := Scale(Font.Size);
-end;
-
-procedure TDpiButton.UpdateBounds;
-begin
-  inherited;
-  VclButton.SetBounds(Scale(Left), Scale(Top), Scale(Width), Scale(Height));
-end;
-
-procedure TDpiButton.SetVisible(AValue: Boolean);
-begin
-  inherited;
-  VclButton.Visible := AValue;
-end;
-
-procedure TDpiButton.SetCaption(AValue: string);
-begin
-  inherited;
-  VclButton.Caption := AValue;
-end;
-
-procedure TDpiButton.SetParent(AValue: TDpiWinControl);
-begin
-  inherited;
-  if Assigned(Owner) and (Owner is TDpiForm) then
-    VclButton.Parent := TDpiForm(Owner).VclForm;
+function TDpiButton.GetVclControl: TControl;
+begin
+  Result := VclButton;
 end;
 
@@ -307 +332 @@
   inherited;
   VclButton := TButton.Create(nil);
+  ScreenChanged;
 end;
 
@@ -328 +354 @@
   if FVisible = AValue then Exit;
   FVisible := AValue;
+  GetVclControl.Visible := AValue;;
 end;
 
@@ -337 +364 @@
 end;
 
+function TDpiControl.GetVclControl: TControl;
+begin
+  Result := nil;
+end;
+
 procedure TDpiControl.ScreenChanged;
 begin
   UpdateBounds;
-  FontChanged(nil);
+  Font.ScreenChanged;
 end;
 
@@ -389 +421 @@
 procedure TDpiControl.SetCaption(AValue: string);
 begin
-  if FCaption=AValue then Exit;
-  FCaption:=AValue;
+  if FCaption = AValue then Exit;
+  FCaption := AValue;
+  GetVclControl.Caption := AValue;
 end;
 
@@ -396 +429 @@
 begin
   if FParent = AValue then Exit;
-  if Assigned(FParent) then FParent.Controls.Remove(Self);
+  if Assigned(FParent) then begin
+    FParent.Controls.Remove(Self);
+    if Assigned(FParent) and (FParent is TDpiWinControl) then
+      GetVclControl.Parent := nil;
+  end;
   FParent := AValue;
-  if Assigned(FParent) then FParent.Controls.Add(Self);
+  if Assigned(FParent) then begin
+    FParent.Controls.Add(Self);
+    if Assigned(FParent) and (FParent is TDpiWinControl) then
+      GetVclControl.Parent := TDpiWinControl(FParent).GetVclWinControl;
+  end;
 end;
 
@@ -409 +450 @@
 procedure TDpiControl.FontChanged(Sender: TObject);
 begin
+  GetVclControl.Font.Size := Scale(Font.Size);
 end;
 
 procedure TDpiControl.UpdateBounds;
 begin
+  GetVclControl.SetBounds(Scale(Left), Scale(Top), Scale(Width), Scale(Height));
 end;
 
@@ -466 +509 @@
 end;
 
-procedure TDpiForm.SetVisible(AValue: Boolean);
-begin
-  inherited SetVisible(AValue);
-  VclForm.Visible := AValue;
-end;
-
-procedure TDpiForm.SetCaption(AValue: string);
-begin
-  inherited;
-  VclForm.Caption:= AValue;
+function TDpiForm.GetVclControl: TControl;
+begin
+  Result := VclForm;
+end;
+
+function TDpiForm.GetVclWinControl: TWinControl;
+begin
+  Result := VclForm;
 end;
 
@@ -485 +526 @@
 end;
 
-procedure TDpiForm.FontChanged(Sender: TObject);
-begin
-  inherited;
-  VclForm.Font.Size := Scale(Font.Size);
-end;
-
-procedure TDpiForm.UpdateBounds;
-begin
-  inherited;
-  VclForm.SetBounds(Scale(Left), Scale(Top), Scale(Width), Scale(Height));
-end;
-
 // Init the component with an IDE resource
 constructor TDpiForm.Create(TheOwner: TComponent);
 begin
+  inherited;
   VclForm := TForm.Create(nil);
+  ScreenChanged;
   DebugLn(['TDpiForm.Create ', DbgSName(TheOwner)]);
   GlobalNameSpace.BeginWrite;
   try
-    inherited Create(TheOwner);
     if (ClassType <> TDpiForm) and not (csDesigning in ComponentState)
     then begin