Changeset 73 for trunk/Packages/Common/UScaleDPI.pas

Timestamp:

Oct 27, 2016, 3:00:47 PM (8 years ago)

Author:

chronos

Message:

• Added: Remember position and size of main form after close of application.
• Modified: Updated Common package to latest version.

File:

• trunk/Packages/Common/UScaleDPI.pas (modified) (12 diffs)

trunk/Packages/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;
+    FontHeight: Integer;
+    Controls: TObjectList; // TList<TControlDimension>
+    // Class specifics
+    ButtonSize: TPoint; // TToolBar
+    CoolBandWidth: Integer;
+    ConstraintsMin: TPoint; // TForm
+    ConstraintsMax: TPoint; // TForm
+    constructor Create;
+    destructor Destroy; override;
+  end;
 
   { TScaleDPI }
@@ -17 +33 @@
   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); override;
+    property DesignDPI: TPoint read FDesignDPI write SetDesignDPI;
+    property DPI: TPoint read FDPI write SetDPI;
   published
     property AutoDetect: Boolean read FAutoDetect write SetAutoDetect;
@@ -34 +58 @@
 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
+  FreeAndNil(Controls);
+  inherited Destroy;
 end;
 
@@ -50 +91 @@
 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.ButtonSize := Point(TToolBar(Control).ButtonWidth, TToolBar(Control).ButtonHeight);
+  if Control is TForm then begin
+    Dimensions.ConstraintsMin := Point(TForm(Control).Constraints.MinWidth,
+      TForm(Control).Constraints.MinHeight);
+    Dimensions.ConstraintsMax := Point(TForm(Control).Constraints.MaxWidth,
+      TForm(Control).Constraints.MaxHeight);
+  end;
+  if Control is TWinControl then
+  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
+    if TWinControl(Control).Controls[I] is TControl then
+    // Do not scale docked forms twice
+    if not (TWinControl(Control).Controls[I] is TForm) 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.ButtonSize.X;
+    TToolBar(Control).ButtonHeight := Dimensions.ButtonSize.Y;
+  end;
+  if Control is TForm then begin
+    TForm(Control).Constraints.MinWidth := Dimensions.ConstraintsMin.X;
+    TForm(Control).Constraints.MinHeight := Dimensions.ConstraintsMin.Y;
+    TForm(Control).Constraints.MaxWidth := Dimensions.ConstraintsMax.X;
+    TForm(Control).Constraints.MaxHeight := Dimensions.ConstraintsMax.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
+    // Do not scale docked forms twice
+    if not (TWinControl(Control).Controls[I] is TForm) 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.ButtonSize.X, DesignDPI.X);
+    TToolBar(Control).ButtonHeight := ScaleY(Dimensions.ButtonSize.Y, DesignDPI.Y);
+  end;
+  if Control is TCoolBar then begin
+    with TCoolBar(Control) do
+    for I := 0 to Bands.Count - 1 do
+    with TCoolBand(Bands[I]) do begin
+      MinWidth := ScaleX(Dimensions.ButtonSize.X, DesignDPI.X);
+      MinHeight := ScaleY(Dimensions.ButtonSize.Y, DesignDPI.Y);
+      //Width := ScaleX(Dimensions.BoundsRect.Left -
+    end;
+  end;
+  if Control is TForm then begin
+    TForm(Control).Constraints.MinWidth := ScaleX(Dimensions.ConstraintsMin.X, DesignDPI.X);
+    TForm(Control).Constraints.MaxWidth := ScaleX(Dimensions.ConstraintsMax.X, DesignDPI.X);
+    TForm(Control).Constraints.MinHeight := ScaleY(Dimensions.ConstraintsMin.Y, DesignDPI.Y);
+    TForm(Control).Constraints.MaxHeight := ScaleY(Dimensions.ConstraintsMax.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
+    // Do not scale docked forms twice
+    if not (TWinControl(Control).Controls[I] is TForm) then begin
+      ScaleDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
+    end;
+  end;
+end;
+
 procedure TScaleDPI.ApplyToAll(FromDPI: TPoint);
 var
@@ -55 +204 @@
 begin
   for I := 0 to Screen.FormCount - 1 do begin
-    ScaleDPI(Screen.Forms[I], FromDPI);
+    ScaleControl(Screen.Forms[I], FromDPI);
   end;
 end;
@@ -70 +219 @@
 
   SetLength(Temp, ImgList.Count);
-  TempBmp := TBitmap.Create;
   for I := 0 to ImgList.Count - 1 do
   begin
+    TempBmp := TBitmap.Create;
+    TempBmp.PixelFormat := pf32bit;
     ImgList.GetBitmap(I, TempBmp);
-    //TempBmp.PixelFormat := pfDevice;
     Temp[I] := TBitmap.Create;
     Temp[I].SetSize(NewWidth, NewHeight);
+    Temp[I].PixelFormat := pf32bit;
     Temp[I].TransparentColor := TempBmp.TransparentColor;
     //Temp[I].TransparentMode := TempBmp.TransparentMode;
@@ -86 +236 @@
     if (Temp[I].Width = 0) or (Temp[I].Height = 0) then Continue;
     Temp[I].Canvas.StretchDraw(Rect(0, 0, Temp[I].Width, Temp[I].Height), TempBmp);
-  end;
-  TempBmp.Free;
+    TempBmp.Free;
+  end;
 
   ImgList.Clear;
@@ -110 +260 @@
 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 +279 @@
 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 +305 @@
       Font.Height := ScaleY(Font.GetTextHeight('Hg'), FromDPI.Y);
     {$ENDIF}
+    //Anchors := OldAnchors;
+    //AutoSize := OldAutoSize;
   end;
 
@@ -149 +317 @@
   end;
 
+  //if not (Control is TCustomPage) then
   if Control is TWinControl then begin
     WinControl := TWinControl(Control);
@@ -154 +323 @@
       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;