Changeset 469

Timestamp:

Dec 4, 2014, 9:49:58 PM (10 years ago)

Author:

chronos

Message:

• Added: Different ScaleDPI scaling approach which use stored dimensions and then apply scaling against stored dimensions. So AutoSizing problem with some controls are solved.

Location:

Common

Files:

• Demo (added)
• Demo/ScaleDPI (added)
• Demo/ScaleDPI/ScaleDPI.ico (added)
• Demo/ScaleDPI/ScaleDPI.lpi (added)
• Demo/ScaleDPI/ScaleDPI.lpr (added)
• Demo/ScaleDPI/ScaleDPI.lps (added)
• Demo/ScaleDPI/ScaleDPI.res (added)
• Demo/ScaleDPI/UFormMain.lfm (added)
• Demo/ScaleDPI/UFormMain.pas (added)
• Demo/ScaleDPI/UFormTest.lfm (added)
• Demo/ScaleDPI/UFormTest.pas (added)
• UScaleDPI.pas (modified) (10 diffs)

Common/UScaleDPI.pas

@@ -8 +8 @@
 
 uses
-  Classes, Forms, Graphics, Controls, ComCtrls, LCLType;
+  Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, StdCtrls,
+  Contnrs;
 
 type
+
+  { TControlDimension }
+
+  TControlDimension = class
+    BoundsRect: TRect;
+    AuxSize: TPoint;
+    FontHeight: Integer;
+    Controls: TObjectList; // TList<TControlDimension>
+    constructor Create;
+    destructor Destroy; override;
+  end;
 
   { TScaleDPI }
@@ -17 +29 @@
   private
     FAutoDetect: Boolean;
+    FDesignDPI: TPoint;
+    FDPI: TPoint;
     procedure SetAutoDetect(AValue: Boolean);
+    procedure SetDesignDPI(AValue: TPoint);
+    procedure SetDPI(AValue: TPoint);
   public
-    DPI: TPoint;
-    DesignDPI: TPoint;
+    procedure StoreDimensions(Control: TControl; Dimensions: TControlDimension);
+    procedure RestoreDimensions(Control: TControl; Dimensions: TControlDimension);
+    procedure ScaleDimensions(Control: TControl; Dimensions: TControlDimension);
     procedure ApplyToAll(FromDPI: TPoint);
-    procedure ScaleDPI(Control: TControl; FromDPI: TPoint);
+    procedure ScaleControl(Control: TControl; FromDPI: TPoint);
     procedure ScaleImageList(ImgList: TImageList; FromDPI: TPoint);
-    function ScaleXY(Size: TPoint; FromDPI: Integer): TPoint;
+    function ScalePoint(APoint: TPoint; FromDPI: TPoint): TPoint;
+    function ScaleRect(ARect: TRect; FromDPI: TPoint): TRect;
     function ScaleX(Size: Integer; FromDPI: Integer): Integer;
     function ScaleY(Size: Integer; FromDPI: Integer): Integer;
-    constructor Create(AOwner: TComponent);
+    constructor Create(AOwner: TComponent); override;
+    property DesignDPI: TPoint read FDesignDPI write SetDesignDPI;
+    property DPI: TPoint read FDPI write SetDPI;
   published
     property AutoDetect: Boolean read FAutoDetect write SetAutoDetect;
@@ -34 +54 @@
 procedure Register;
 
+
 implementation
 
+resourcestring
+  SWrongDPI = 'Wrong DPI [%d,%d]';
+
 procedure Register;
 begin
   RegisterComponents('Common', [TScaleDPI]);
+end;
+
+{ TControlDimension }
+
+constructor TControlDimension.Create;
+begin
+  Controls := TObjectList.Create;
+end;
+
+destructor TControlDimension.Destroy;
+begin
+  Controls.Free;
+  inherited Destroy;
 end;
 
@@ -50 +87 @@
 end;
 
+procedure TScaleDPI.SetDesignDPI(AValue: TPoint);
+begin
+  if (FDesignDPI.X = AValue.X) and (FDesignDPI.Y = AValue.Y) then Exit;
+  if (AValue.X <= 0) or (AValue.Y <= 0) then
+    raise Exception.Create(Format(SWrongDPI, [AValue.X, AValue.Y]));
+  FDesignDPI := AValue;
+end;
+
+procedure TScaleDPI.SetDPI(AValue: TPoint);
+begin
+  if (FDPI.X = AValue.X) and (FDPI.Y = AValue.Y) then Exit;
+  if (AValue.X <= 0) or (AValue.Y <= 0) then
+    raise Exception.Create(Format(SWrongDPI, [AValue.X, AValue.Y]));
+  FDPI := AValue;
+end;
+
+procedure TScaleDPI.StoreDimensions(Control: TControl;
+  Dimensions: TControlDimension);
+var
+  NewControl: TControlDimension;
+  I: Integer;
+begin
+  Dimensions.BoundsRect := Control.BoundsRect;
+  Dimensions.FontHeight := Control.Font.GetTextHeight('Hg');
+  Dimensions.Controls.Clear;
+  if Control is TToolBar then
+    Dimensions.AuxSize := Point(TToolBar(Control).ButtonWidth, TToolBar(Control).ButtonHeight);
+
+  if Control is TWinControl then
+  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
+    if TWinControl(Control).Controls[I] is TControl then begin
+      NewControl := TControlDimension.Create;
+      Dimensions.Controls.Add(NewControl);
+      StoreDimensions(TWinControl(Control).Controls[I], NewControl);
+    end;
+  end;
+end;
+
+procedure TScaleDPI.RestoreDimensions(Control: TControl;
+  Dimensions: TControlDimension);
+var
+  I: Integer;
+begin
+  Control.BoundsRect := Dimensions.BoundsRect;
+  Control.Font.Height := Dimensions.FontHeight;
+  if Control is TToolBar then begin
+    TToolBar(Control).ButtonWidth := Dimensions.AuxSize.X;
+    TToolBar(Control).ButtonHeight := Dimensions.AuxSize.Y;
+  end;
+  if Control is TWinControl then
+  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
+    if TWinControl(Control).Controls[I] is TControl then begin
+      RestoreDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
+    end;
+  end;
+end;
+
+procedure TScaleDPI.ScaleDimensions(Control: TControl;
+  Dimensions: TControlDimension);
+var
+  I: Integer;
+begin
+  Control.BoundsRect := ScaleRect(Dimensions.BoundsRect, DesignDPI);
+  Control.Font.Height := ScaleY(Dimensions.FontHeight, DesignDPI.Y);
+  if Control is TToolBar then begin
+    TToolBar(Control).ButtonWidth := ScaleX(Dimensions.AuxSize.X, DesignDPI.X);
+    TToolBar(Control).ButtonHeight := ScaleY(Dimensions.AuxSize.Y, DesignDPI.Y);
+  end;
+  if Control is TWinControl then
+  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
+    if TWinControl(Control).Controls[I] is TControl then begin
+      ScaleDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
+    end;
+  end;
+end;
+
 procedure TScaleDPI.ApplyToAll(FromDPI: TPoint);
 var
@@ -55 +168 @@
 begin
   for I := 0 to Screen.FormCount - 1 do begin
-    ScaleDPI(Screen.Forms[I], FromDPI);
+    ScaleControl(Screen.Forms[I], FromDPI);
   end;
 end;
@@ -110 +223 @@
 end;
 
-function TScaleDPI.ScaleXY(Size: TPoint; FromDPI: Integer): TPoint;
-begin
-  Result.X := ScaleX(Size.X, FromDPI);
-  Result.Y := ScaleY(Size.Y, FromDPI);
+function TScaleDPI.ScalePoint(APoint: TPoint; FromDPI: TPoint): TPoint;
+begin
+  Result.X := ScaleX(APoint.X, FromDPI.X);
+  Result.Y := ScaleY(APoint.Y, FromDPI.Y);
+end;
+
+function TScaleDPI.ScaleRect(ARect: TRect; FromDPI: TPoint): TRect;
+begin
+  Result.TopLeft := ScalePoint(ARect.TopLeft, FromDPI);
+  Result.BottomRight := ScalePoint(ARect.BottomRight, FromDPI);
 end;
 
@@ -123 +242 @@
 end;
 
-procedure TScaleDPI.ScaleDPI(Control: TControl; FromDPI: TPoint);
+procedure TScaleDPI.ScaleControl(Control: TControl; FromDPI: TPoint);
 var
   I: Integer;
   WinControl: TWinControl;
   ToolBarControl: TToolBar;
-begin
+  OldAnchors: TAnchors;
+  OldAutoSize: Boolean;
+begin
+  //if Control is TMemo then Exit;
+  //if Control is TForm then
+  //  Control.DisableAutoSizing;
   with Control do begin
+    //OldAutoSize := AutoSize;
+    //AutoSize := False;
+    //Anchors := [];
     Left := ScaleX(Left, FromDPI.X);
     Top := ScaleY(Top, FromDPI.Y);
+    //if not (akRight in Anchors) then
     Width := ScaleX(Width, FromDPI.X);
+    //if not (akBottom in Anchors) then
     Height := ScaleY(Height, FromDPI.Y);
     {$IFDEF LCL Qt}
@@ -139 +268 @@
       Font.Height := ScaleY(Font.GetTextHeight('Hg'), FromDPI.Y);
     {$ENDIF}
-  end;
+    //Anchors := OldAnchors;
+    //AutoSize := OldAutoSize;
+  end;
+
+
 
   if Control is TToolBar then begin
@@ -149 +282 @@
   end;
 
+  //if not (Control is TCustomPage) then
   if Control is TWinControl then begin
     WinControl := TWinControl(Control);
@@ -154 +288 @@
       for I := 0 to WinControl.ControlCount - 1 do begin
         if WinControl.Controls[I] is TControl then begin
-          ScaleDPI(WinControl.Controls[I], FromDPI);
+          ScaleControl(WinControl.Controls[I], FromDPI);
         end;
       end;
     end;
   end;
+  //if Control is TForm then
+  //  Control.EnableAutoSizing;
 end;