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

Timestamp:

Sep 10, 2022, 6:54:43 PM (20 months ago)

Author:

chronos

Message:

• Modified: CoolTranslator replaced by Common package.
• Modified: Update common package.

File:

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

trunk/Packages/Common/UScaleDPI.pas

@@ -3 +3 @@
 { See: http://wiki.lazarus.freepascal.org/High_DPI }
 
-{$mode delphi}{$H+}
-
 interface
 
 uses
-  Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, StdCtrls,
-  Contnrs;
+  Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils,
+  Generics.Collections;
 
 type
+  TControlDimensions = class;
 
   { TControlDimension }
@@ -18 +17 @@
     BoundsRect: TRect;
     FontHeight: Integer;
-    Controls: TObjectList; // TList<TControlDimension>
+    Controls: TControlDimensions;
     // Class specifics
     ButtonSize: TPoint; // TToolBar
@@ -26 +25 @@
     constructor Create;
     destructor Destroy; override;
+  end;
+
+  TControlDimensions = class(TObjectList<TControlDimension>)
   end;
 
@@ -73 +75 @@
 constructor TControlDimension.Create;
 begin
-  Controls := TObjectList.Create;
+  Controls := TControlDimensions.Create;
 end;
 
@@ -79 +81 @@
 begin
   FreeAndNil(Controls);
-  inherited Destroy;
+  inherited;
 end;
 
@@ -212 +214 @@
   TempBmp: TBitmap;
   Temp: array of TBitmap;
-  NewWidth, NewHeight: integer;
-  I: Integer;
-begin
-  NewWidth := ScaleX(ImgList.Width, FromDPI.X);
-  NewHeight := ScaleY(ImgList.Height, FromDPI.Y);
-
-  SetLength(Temp, ImgList.Count);
-  for I := 0 to ImgList.Count - 1 do
-  begin
-    TempBmp := TBitmap.Create;
-    TempBmp.PixelFormat := pf32bit;
-    ImgList.GetBitmap(I, TempBmp);
-    Temp[I] := TBitmap.Create;
-    Temp[I].SetSize(NewWidth, NewHeight);
-    Temp[I].PixelFormat := pf32bit;
-    Temp[I].TransparentColor := TempBmp.TransparentColor;
-    //Temp[I].TransparentMode := TempBmp.TransparentMode;
-    Temp[I].Transparent := True;
-    Temp[I].Canvas.Brush.Style := bsSolid;
-    Temp[I].Canvas.Brush.Color := Temp[I].TransparentColor;
-    Temp[I].Canvas.FillRect(0, 0, Temp[I].Width, Temp[I].Height);
-
-    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);
-    TempBmp.Free;
-  end;
-
-  ImgList.Clear;
-  ImgList.Width := NewWidth;
-  ImgList.Height := NewHeight;
-
-  for I := 0 to High(Temp) do
-  begin
-    ImgList.Add(Temp[I], nil);
-    Temp[i].Free;
+  NewWidth: Integer;
+  NewHeight: Integer;
+  I: Integer;
+begin
+  ImgList.BeginUpdate;
+  try
+    NewWidth := ScaleX(ImgList.Width, FromDPI.X);
+    NewHeight := ScaleY(ImgList.Height, FromDPI.Y);
+
+    Temp := nil;
+    SetLength(Temp, ImgList.Count);
+    for I := 0 to ImgList.Count - 1 do
+    begin
+      TempBmp := TBitmap.Create;
+      try
+        TempBmp.PixelFormat := pf32bit;
+        ImgList.GetBitmap(I, TempBmp);
+        Temp[I] := TBitmap.Create;
+        Temp[I].SetSize(NewWidth, NewHeight);
+        {$IFDEF UNIX}
+        Temp[I].PixelFormat := pf24bit;
+        {$ELSE}
+        Temp[I].PixelFormat := pf32bit;
+        {$ENDIF}
+        Temp[I].TransparentColor := TempBmp.TransparentColor;
+        //Temp[I].TransparentMode := TempBmp.TransparentMode;
+        Temp[I].Transparent := True;
+        Temp[I].Canvas.Brush.Style := bsSolid;
+        Temp[I].Canvas.Brush.Color := Temp[I].TransparentColor;
+        Temp[I].Canvas.FillRect(0, 0, Temp[I].Width, Temp[I].Height);
+
+        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);
+      finally
+        TempBmp.Free;
+      end;
+    end;
+
+    ImgList.Clear;
+    ImgList.Width := NewWidth;
+    ImgList.Height := NewHeight;
+
+    for I := 0 to High(Temp) do
+    begin
+      ImgList.Add(Temp[I], nil);
+      Temp[i].Free;
+    end;
+  finally
+    ImgList.EndUpdate;
   end;
 end;
@@ -284 +300 @@
   WinControl: TWinControl;
   ToolBarControl: TToolBar;
-  OldAnchors: TAnchors;
-  OldAutoSize: Boolean;
-begin
+  //OldAnchors: TAnchors;
+  //OldAutoSize: Boolean;
+begin
+  //if not (Control is TCustomPage) then
+  // Resize childs first
+  if Control is TWinControl then begin
+    WinControl := TWinControl(Control);
+    if WinControl.ControlCount > 0 then begin
+      for I := 0 to WinControl.ControlCount - 1 do begin
+        if WinControl.Controls[I] is TControl then begin
+          ScaleControl(WinControl.Controls[I], FromDPI);
+        end;
+      end;
+    end;
+  end;
+
   //if Control is TMemo then Exit;
   //if Control is TForm then
@@ -312 +341 @@
   with TCoolBar(Control) do begin
     BeginUpdate;
-    for I := 0 to Bands.Count - 1 do
-      with Bands[I] do begin
-        MinWidth := ScaleX(MinWidth, FromDPI.X);
-        MinHeight := ScaleY(MinHeight, FromDPI.Y);
-        Width := ScaleX(Width, FromDPI.X);
-        //Control.Invalidate;
+    try
+      for I := 0 to Bands.Count - 1 do
+        with Bands[I] do begin
+          MinWidth := ScaleX(MinWidth, FromDPI.X);
+          MinHeight := ScaleY(MinHeight, FromDPI.Y);
+          // Workaround to bad band width auto sizing
+          //Width := ScaleX(Width, FromDPI.X);
+          Width := ScaleX(Control.Width + 28, FromDPI.X);
+          //Control.Invalidate;
+        end;
+      // Workaround for bad autosizing of coolbar
+      if AutoSize then begin
+        AutoSize := False;
+        Height := ScaleY(Height, FromDPI.Y);
+        AutoSize := True;
       end;
-    EndUpdate;
+    finally
+      EndUpdate;
+    end;
   end;
 
@@ -330 +370 @@
   end;
 
-  //if not (Control is TCustomPage) then
-  if Control is TWinControl then begin
-    WinControl := TWinControl(Control);
-    if WinControl.ControlCount > 0 then begin
-      for I := 0 to WinControl.ControlCount - 1 do begin
-        if WinControl.Controls[I] is TControl then begin
-          ScaleControl(WinControl.Controls[I], FromDPI);
-        end;
-      end;
-    end;
-  end;
   //if Control is TForm then
   //  Control.EnableAutoSizing;