瀏覽代碼

Make TBitmapButton.AutoSize work as expected + related cleanup.

Martijn Laan 1 月之前
父節點
當前提交
b998e36d1f
共有 2 個文件被更改,包括 46 次插入11 次删除
  1. 26 8
      Components/BitmapButton.pas
  2. 20 3
      Components/BitmapImage.pas

+ 26 - 8
Components/BitmapButton.pas

@@ -26,6 +26,7 @@ type
 
   TBitmapButton = class(TCustomControl)
   private
+    FFocusBorderWidth, FFocusBorderHeight: Integer;
     FImpl: TBitmapImageImplementation;
     FOnClick: TNotifyEvent;
     FOnDblClick: TNotifyEvent;
@@ -46,6 +47,7 @@ type
     procedure SetAutoSize(Value: Boolean); override;
   public
     constructor Create(AOwner: TComponent); override;
+    procedure CreateHandle; override;
     destructor Destroy; override;
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
   published
@@ -84,7 +86,9 @@ constructor TBitmapButton.Create(AOwner: TComponent);
 begin
   inherited;
   ControlStyle := ControlStyle + [csReplicatable];
-  FImpl.Init(Self);
+  FFocusBorderWidth := 2;
+  FFocusBorderHeight := 2;
+  FImpl.Init(Self, 2*FFocusBorderWidth, 2*FFocusBorderHeight);
   TabStop := True;
   Height := 105;
   Width := 105;
@@ -96,6 +100,26 @@ begin
   CreateSubClass(Params, 'BUTTON');
 end;
 
+procedure TBitmapButton.CreateHandle;
+begin
+  inherited;
+  { Note: On Windows 11 the focus border is always 2 pixels wide / high, even at 200% DPI and even
+    when calling GetSystemMetricsForDpi, so on Windows 11 this code does nothing }
+
+  var W := GetSystemMetrics(SM_CXFOCUSBORDER); { This calls GetSystemMetricsForDpi }
+  if W = 0 then
+    W := 2;
+  var H := GetSystemMetrics(SM_CYFOCUSBORDER);
+  if H = 0 then
+    H := 2;
+
+  if (W <> FFocusBorderWidth) or (H <> FFocusBorderHeight) then begin
+    FFocusBorderWidth := W;
+    FFocusBorderHeight := H;
+    FImpl.SetAutoSizeExtraWidthHeight(Self, 2*FFocusBorderWidth, 2*FFocusBorderHeight);
+  end;
+end;
+
 destructor TBitmapButton.Destroy;
 begin
   FImpl.DeInit;
@@ -162,13 +186,7 @@ begin
     Canvas.DrawFocusRect(R);
   end;
 
-  { Note: On Windows 11 the focus rectangle border is always 2 pixels wide / high, even at 200% DPI }
-  var FocusBorderWidth: UINT := 2;
-  var FocusBorderHeight: UINT := 2;
-  SystemParametersInfo(SPI_GETFOCUSBORDERWIDTH, 0, @FocusBorderWidth, 0);
-  SystemParametersInfo(SPI_GETFOCUSBORDERHEIGHT, 0, @FocusBorderHeight, 0);
-
-  InflateRect(R, -FocusBorderWidth, -FocusBorderHeight);
+  InflateRect(R, -FFocusBorderWidth, -FFocusBorderHeight);
 
   FImpl.Paint(Canvas, R);
 

+ 20 - 3
Components/BitmapImage.pas

@@ -22,6 +22,7 @@ type
     FControl: TControl;
   public
     AutoSize: Boolean;
+    AutoSizeExtraWidth, AutoSizeExtraHeight: Integer;
     BackColor: TColor;
     Bitmap: TBitmap;
     Center: Boolean;
@@ -30,11 +31,13 @@ type
     Stretch: Boolean;
     StretchedBitmap: TBitmap;
     StretchedBitmapValid: Boolean;
-    procedure Init(const AControl: TControl);
+    procedure Init(const AControl: TControl; const AAutoSizeExtraWidth: Integer = 0;
+      const AAutoSizeExtraHeight: Integer = 0);
     procedure DeInit;
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
     procedure BitmapChanged(Sender: TObject);
     procedure SetAutoSize(Sender: TObject; Value: Boolean);
+    procedure SetAutoSizeExtraWidthHeight(Sender: TObject; Width, Height: Integer);
     procedure SetBackColor(Sender: TObject; Value: TColor);
     procedure SetBitmap(Value: TBitmap);
     procedure SetCenter(Sender: TObject; Value: Boolean);
@@ -104,9 +107,12 @@ end;
 
 { TBitmapImageImplementation }
 
-procedure TBitmapImageImplementation.Init(const AControl: TControl);
+procedure TBitmapImageImplementation.Init(const AControl: TControl;
+  const AAutoSizeExtraWidth, AAutoSizeExtraHeight: Integer);
 begin
   FControl := AControl;
+  AutoSizeExtraWidth := AAutoSizeExtraWidth;
+  AutoSizeExtraHeight := AAutoSizeExtraHeight;
   Bitmap := TBitmap.Create;
   Bitmap.OnChange := BitmapChanged;
   BackColor := clNone;
@@ -168,7 +174,8 @@ procedure TBitmapImageImplementation.BitmapChanged(Sender: TObject);
 begin
   StretchedBitmapValid := False;
   if AutoSize and (Bitmap.Width > 0) and (Bitmap.Height > 0) then
-    FControl.SetBounds(FControl.Left, FControl.Top, Bitmap.Width, Bitmap.Height);
+    FControl.SetBounds(FControl.Left, FControl.Top, Bitmap.Width + AutoSizeExtraWidth,
+      Bitmap.Height + AutoSizeExtraHeight);
   if (Bitmap.Width >= FControl.Width) and (Bitmap.Height >= FControl.Height) then
     FControl.ControlStyle := FControl.ControlStyle + [csOpaque] - [csParentBackground]
   else
@@ -182,6 +189,16 @@ begin
   BitmapChanged(Sender);
 end;
 
+procedure TBitmapImageImplementation.SetAutoSizeExtraWidthHeight(Sender: TObject; Width, Height: Integer);
+begin
+  if (Width <> AutoSizeExtraWidth) or (Height <> AutoSizeExtraHeight) then begin
+    AutoSizeExtraWidth := Width;
+    AutoSizeExtraHeight := Height;
+    if AutoSize then
+      BitmapChanged(Sender);
+  end;
+end;
+
 procedure TBitmapImageImplementation.SetBackColor(Sender: TObject; Value: TColor);
 begin
   if BackColor <> Value then begin