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

Timestamp:

Dec 24, 2022, 7:17:24 PM (23 months ago)

Author:

chronos

Message:

• Modified: Updated Common package to latest version.
• Modified: Build with Lazarus 2.2.4.

Location:

trunk

Files:

• . (modified) (1 prop)
• Packages/Common/UScaleDPI.pas (modified) (7 diffs)

trunk

@@ -6 +6 @@
 Tunneler.dbg
 tunneler.lps
+*.res
 heaptrclog.trc
 Components/Common/Languages/*.mo
-Components/CoolTranslator/Demo/lib
+

@@ -6 +6 @@
 Tunneler.dbg
 tunneler.lps
+*.res
 heaptrclog.trc
 Components/Common/Languages/*.mo
-Components/CoolTranslator/Demo/lib
+

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;
+  NewWidth: Integer;
+  NewHeight: Integer;
   I: Integer;
 begin
   ImgList.BeginUpdate;
-  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);
-    {$IFDEF Linux}
-    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);
-    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;
-  end;
-  ImgList.EndUpdate;
+  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;
 
@@ -331 +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);
-        // Workaround to bad band width auto sizing
-        //Width := ScaleX(Width, FromDPI.X);
-        Width := ScaleX(Control.Width + 28, 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;
-    // 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;
 

@@ -6 +6 @@
 Tunneler.dbg
 tunneler.lps
+*.res
 heaptrclog.trc
 Components/Common/Languages/*.mo
-Components/CoolTranslator/Demo/lib
+