Bläddra i källkod

Use a fixed focus border width/height of 2 pixels to avoid design problems between systems. Also set Center to True by default + few more minor changes.

Martijn Laan 1 månad sedan
förälder
incheckning
b22b1c9878

+ 12 - 31
Components/BitmapButton.pas

@@ -10,7 +10,7 @@ unit BitmapButton;
   which is actually a button with a focus rectangle when focused - in
   which is actually a button with a focus rectangle when focused - in
   other words: an accessible TImage
   other words: an accessible TImage
   
   
-  Make sure to set the Caption property even if it isn't visible
+  Make sure to set the Caption property, even if it isn't visible
 
 
   Also see TBitmapImage which is the TGraphicControl version
   Also see TBitmapImage which is the TGraphicControl version
 }
 }
@@ -24,7 +24,7 @@ uses
 type
 type
   TBitmapButton = class(TCustomControl)
   TBitmapButton = class(TCustomControl)
   private
   private
-    FFocusBorderWidth, FFocusBorderHeight: Integer;
+    FFocusBorderWidthHeight: Integer;
     FImpl: TBitmapImageImplementation;
     FImpl: TBitmapImageImplementation;
     FOnClick: TNotifyEvent;
     FOnClick: TNotifyEvent;
     FOnDblClick: TNotifyEvent;
     FOnDblClick: TNotifyEvent;
@@ -44,7 +44,6 @@ type
     procedure SetAutoSize(Value: Boolean); override;
     procedure SetAutoSize(Value: Boolean); override;
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
-    procedure CreateWnd; override;
     destructor Destroy; override;
     destructor Destroy; override;
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
   published
   published
@@ -53,7 +52,7 @@ type
     property AutoSize: Boolean read FImpl.AutoSize write SetAutoSize default False;
     property AutoSize: Boolean read FImpl.AutoSize write SetAutoSize default False;
     property BackColor: TColor read FImpl.BackColor write SetBackColor default clNone;
     property BackColor: TColor read FImpl.BackColor write SetBackColor default clNone;
     property Caption;
     property Caption;
-    property Center: Boolean read FImpl.Center write SetCenter default False;
+    property Center: Boolean read FImpl.Center write SetCenter default True;
     property Enabled;
     property Enabled;
     property ParentShowHint;
     property ParentShowHint;
     property Bitmap: TBitmap read FImpl.Bitmap write SetBitmap;
     property Bitmap: TBitmap read FImpl.Bitmap write SetBitmap;
@@ -83,12 +82,14 @@ constructor TBitmapButton.Create(AOwner: TComponent);
 begin
 begin
   inherited;
   inherited;
   ControlStyle := ControlStyle + [csReplicatable];
   ControlStyle := ControlStyle + [csReplicatable];
-  FFocusBorderWidth := 1;
-  FFocusBorderHeight := 1;
-  FImpl.Init(Self, 2*FFocusBorderWidth, 2*FFocusBorderHeight);
+  { Using a fixed focus border width/height to avoid design problems between systems }
+  FFocusBorderWidthHeight := 2;
+  const DoubleFBWH = 2*FFocusBorderWidthHeight;
+  FImpl.Init(Self, DoubleFBWH, DoubleFBWH);
+  Center := True;
   TabStop := True;
   TabStop := True;
-  Height := 105;
-  Width := 105;
+  Width := 75+DoubleFBWH;
+  Height := 25+DoubleFBWH;
 end;
 end;
 
 
 procedure TBitmapButton.CreateParams(var Params: TCreateParams);
 procedure TBitmapButton.CreateParams(var Params: TCreateParams);
@@ -97,27 +98,6 @@ begin
   CreateSubClass(Params, 'BUTTON');
   CreateSubClass(Params, 'BUTTON');
 end;
 end;
 
 
-procedure TBitmapButton.CreateWnd;
-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;
 destructor TBitmapButton.Destroy;
 begin
 begin
   FImpl.DeInit;
   FImpl.DeInit;
@@ -181,10 +161,11 @@ begin
     Canvas.Pen.Color := clWindowFrame;
     Canvas.Pen.Color := clWindowFrame;
     Canvas.Brush.Style := bsSolid;
     Canvas.Brush.Style := bsSolid;
     Canvas.Brush.Color := clBtnFace;
     Canvas.Brush.Color := clBtnFace;
+    { This might draw a focus border thinner or thicker than our FFocusBorderWidthHeight but that's okay }
     Canvas.DrawFocusRect(R);
     Canvas.DrawFocusRect(R);
   end;
   end;
 
 
-  InflateRect(R, -FFocusBorderWidth, -FFocusBorderHeight);
+  InflateRect(R, -FFocusBorderWidthHeight, -FFocusBorderWidthHeight);
 
 
   FImpl.Paint(Self, Canvas, R);
   FImpl.Paint(Self, Canvas, R);
 end;
 end;

+ 1 - 12
Components/BitmapImage.pas

@@ -40,7 +40,6 @@ type
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
     procedure BitmapChanged(Sender: TObject);
     procedure BitmapChanged(Sender: TObject);
     procedure SetAutoSize(Sender: TObject; Value: Boolean);
     procedure SetAutoSize(Sender: TObject; Value: Boolean);
-    procedure SetAutoSizeExtraWidthHeight(Sender: TObject; Width, Height: Integer);
     procedure SetBackColor(Sender: TObject; Value: TColor);
     procedure SetBackColor(Sender: TObject; Value: TColor);
     procedure SetBitmap(Value: TBitmap);
     procedure SetBitmap(Value: TBitmap);
     procedure SetCenter(Sender: TObject; Value: Boolean);
     procedure SetCenter(Sender: TObject; Value: Boolean);
@@ -193,16 +192,6 @@ begin
   BitmapChanged(Sender);
   BitmapChanged(Sender);
 end;
 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);
 procedure TBitmapImageImplementation.SetBackColor(Sender: TObject; Value: TColor);
 begin
 begin
   if BackColor <> Value then begin
   if BackColor <> Value then begin
@@ -332,8 +321,8 @@ begin
   ControlStyle := ControlStyle + [csReplicatable];
   ControlStyle := ControlStyle + [csReplicatable];
   FImpl.Init(Self);
   FImpl.Init(Self);
   FImpl.BackColor := clBtnFace;
   FImpl.BackColor := clBtnFace;
-  Height := 105;
   Width := 105;
   Width := 105;
+  Height := 105;
 end;
 end;
 
 
 destructor TBitmapImage.Destroy;
 destructor TBitmapImage.Destroy;

+ 24 - 8
Examples/CodeClasses.iss

@@ -127,7 +127,7 @@ var
   CheckListBox, CheckListBox2: TNewCheckListBox;
   CheckListBox, CheckListBox2: TNewCheckListBox;
   FolderTreeView: TFolderTreeView;
   FolderTreeView: TFolderTreeView;
   BitmapImage, BitmapImage2, BitmapImage3: TBitmapImage;
   BitmapImage, BitmapImage2, BitmapImage3: TBitmapImage;
-  BitmapButton: TBitmapButton;
+  BitmapButton, BitmapButton2: TBitmapButton;
   BitmapFileName: String;
   BitmapFileName: String;
   RichEditViewer: TRichEditViewer;
   RichEditViewer: TRichEditViewer;
 begin
 begin
@@ -352,32 +352,35 @@ begin
   BitmapImage.Parent := Page.Surface;
   BitmapImage.Parent := Page.Surface;
 
 
   BitmapImage2 := TBitmapImage.Create(Page);
   BitmapImage2 := TBitmapImage.Create(Page);
-  BitmapImage2.BackColor := $400000;
+  BitmapImage2.BackColor := clNone;
   BitmapImage2.Bitmap := BitmapImage.Bitmap;
   BitmapImage2.Bitmap := BitmapImage.Bitmap;
   BitmapImage2.Center := True;
   BitmapImage2.Center := True;
   BitmapImage2.Left := BitmapImage.Width + 10;
   BitmapImage2.Left := BitmapImage.Width + 10;
-  BitmapImage2.Height := 2*BitmapImage.Height;
   BitmapImage2.Width := 2*BitmapImage.Width;
   BitmapImage2.Width := 2*BitmapImage.Width;
+  BitmapImage2.Height := 2*BitmapImage.Height;
   BitmapImage2.Parent := Page.Surface;
   BitmapImage2.Parent := Page.Surface;
 
 
   BitmapImage3 := TBitmapImage.Create(Page);
   BitmapImage3 := TBitmapImage.Create(Page);
   BitmapImage3.Bitmap := BitmapImage.Bitmap;
   BitmapImage3.Bitmap := BitmapImage.Bitmap;
   BitmapImage3.Stretch := True;
   BitmapImage3.Stretch := True;
   BitmapImage3.Left := 3*BitmapImage.Width + 20;
   BitmapImage3.Left := 3*BitmapImage.Width + 20;
-  BitmapImage3.Height := 4*BitmapImage.Height;
   BitmapImage3.Width := 4*BitmapImage.Width;
   BitmapImage3.Width := 4*BitmapImage.Width;
+  BitmapImage3.Height := 4*BitmapImage.Height;
   BitmapImage3.Anchors := [akLeft, akTop, akRight, akBottom];
   BitmapImage3.Anchors := [akLeft, akTop, akRight, akBottom];
   BitmapImage3.Parent := Page.Surface;
   BitmapImage3.Parent := Page.Surface;
 
 
-  { TBitmapButton }
+  { TBitmapButton - Always has a 2 pixel margin around the image, used to
+    display a focus rectangle. Other changes compared to TBitmapImage are:
+    • Has a Caption property which should always be set
+    • Center defaults to True
+    • BackColor defaults to clNone }
 
 
   Page := CreateCustomPage(Page.ID, 'Custom wizard page controls', 'TBitmapButton (Press Alt to see focus rectangle)');
   Page := CreateCustomPage(Page.ID, 'Custom wizard page controls', 'TBitmapButton (Press Alt to see focus rectangle)');
-
+  
   BitmapButton := TBitmapButton.Create(Page);
   BitmapButton := TBitmapButton.Create(Page);
   BitmapButton.AutoSize := True;
   BitmapButton.AutoSize := True;
   BitmapButton.Bitmap := BitmapImage.Bitmap;
   BitmapButton.Bitmap := BitmapImage.Bitmap;
-  BitmapButton.Center := True;
-  BitmapButton.Caption := 'Show Message'; { For accesibility }
+  BitmapButton.Caption := 'Show Message'; { For accessibility }
   BitmapButton.Hint := 'TBitmapButton is an accessible version of TBitmapImage';
   BitmapButton.Hint := 'TBitmapButton is an accessible version of TBitmapImage';
   BitmapButton.ShowHint := True;
   BitmapButton.ShowHint := True;
   BitmapButton.Width := 2*BitmapButton.Width;
   BitmapButton.Width := 2*BitmapButton.Width;
@@ -385,6 +388,19 @@ begin
   BitmapButton.OnClick := @ButtonOnClick;
   BitmapButton.OnClick := @ButtonOnClick;
   BitmapButton.Parent := Page.Surface;
   BitmapButton.Parent := Page.Surface;
 
 
+  BitmapButton2 := TBitmapButton.Create(Page);
+  BitmapButton2.BackColor := $400000;
+  BitmapButton2.Bitmap := BitmapImage.Bitmap;
+  BitmapButton2.Caption := BitmapButton.Caption;
+  BitmapButton2.Hint := BitmapButton.Hint;
+  BitmapButton2.ShowHint := True;
+  BitmapButton2.Left := BitmapButton.Width + 10;
+  BitmapButton2.Width := 2*BitmapButton.Width;
+  BitmapButton2.Height := 2*BitmapButton.Height;
+  BitmapButton2.Cursor := crHand;
+  BitmapButton2.OnClick := @ButtonOnClick;
+  BitmapButton2.Parent := Page.Surface;
+
   { TRichViewer }
   { TRichViewer }
 
 
   Page := CreateCustomPage(Page.ID, 'Custom wizard page controls', 'TRichViewer');
   Page := CreateCustomPage(Page.ID, 'Custom wizard page controls', 'TRichViewer');

+ 0 - 1
Projects/Src/IDE.InputQueryMemoForm.dfm

@@ -35,7 +35,6 @@ object InputQueryMemoForm: TInputQueryMemoForm
     Cursor = crHandPoint
     Cursor = crHandPoint
     Anchors = [akLeft, akBottom]
     Anchors = [akLeft, akBottom]
     Caption = 'Help'
     Caption = 'Help'
-    Center = True
     TabOrder = 1
     TabOrder = 1
   end
   end
   object OKButton: TButton
   object OKButton: TButton

+ 0 - 1
Projects/Src/IDE.MainForm.dfm

@@ -384,7 +384,6 @@ object MainForm: TMainForm
       Margins.Bottom = 8
       Margins.Bottom = 8
       Align = alRight
       Align = alRight
       Caption = 'Close Banner'
       Caption = 'Close Banner'
-      Center = True
       TabOrder = 1
       TabOrder = 1
       OnClick = UpdatePanelCloseBitBtnClick
       OnClick = UpdatePanelCloseBitBtnClick
       OnPaint = UpdatePanelCloseBitBtnPaint
       OnPaint = UpdatePanelCloseBitBtnPaint

+ 0 - 1
Projects/Src/IDE.RegistryDesignerForm.dfm

@@ -25,7 +25,6 @@ object RegistryDesignerForm: TRegistryDesignerForm
     Height = 20
     Height = 20
     Anchors = [akTop, akRight]
     Anchors = [akTop, akRight]
     Caption = 'Help'
     Caption = 'Help'
-    Center = True
     TabOrder = 9
     TabOrder = 9
   end
   end
   object Panel1: TPanel
   object Panel1: TPanel

+ 0 - 2
Projects/Src/IDE.StartupForm.dfm

@@ -26,7 +26,6 @@ object StartupForm: TStartupForm
     Cursor = crHandPoint
     Cursor = crHandPoint
     Anchors = [akLeft, akBottom]
     Anchors = [akLeft, akBottom]
     Caption = 'Donate'
     Caption = 'Donate'
-    Center = True
     ParentShowHint = False
     ParentShowHint = False
     Bitmap.Data = {
     Bitmap.Data = {
       F60B0000424DF60B00000000000036040000280000003E0000001F0000000100
       F60B0000424DF60B00000000000036040000280000003E0000001F0000000100
@@ -138,7 +137,6 @@ object StartupForm: TStartupForm
     Hint = 'Be notified by e-mail of new Inno Setup releases'
     Hint = 'Be notified by e-mail of new Inno Setup releases'
     Anchors = [akLeft, akBottom]
     Anchors = [akLeft, akBottom]
     Caption = 'Subscribe'
     Caption = 'Subscribe'
-    Center = True
     ParentShowHint = False
     ParentShowHint = False
     Bitmap.Data = {
     Bitmap.Data = {
       F60B0000424DF60B00000000000036040000280000003E0000001F0000000100
       F60B0000424DF60B00000000000036040000280000003E0000001F0000000100

+ 0 - 1
Projects/Src/IDE.Wizard.WizardForm.dfm

@@ -1061,7 +1061,6 @@ object WizardForm: TWizardForm
             Height = 20
             Height = 20
             Anchors = [akTop, akRight]
             Anchors = [akTop, akRight]
             Caption = 'Help'
             Caption = 'Help'
-            Center = True
             TabOrder = 9
             TabOrder = 9
           end
           end
           object AppRegistryFileLabel: TNewStaticText
           object AppRegistryFileLabel: TNewStaticText

+ 1 - 1
whatsnew.htm

@@ -226,7 +226,7 @@ issigtool --key-file="MyKey.ispublickey" verify "MyProg.dll"</code></pre>
   </li>
   </li>
   <li>Pascal Scripting changes:
   <li>Pascal Scripting changes:
     <ul>
     <ul>
-      <li>Added new <tt>TBitmapButton</tt> support class which works just like <tt>TBitmapImage</tt>, but is accessible by keyboard and compatible with screen readers. Make sure to set the <tt>Caption</tt> property even if it isn't visible. See updated example script <i>CodeClasses.iss</i> for an example.</li>
+      <li>Added new <tt>TBitmapButton</tt> support class which works just like <tt>TBitmapImage</tt>, but is accessible by keyboard and compatible with screen readers. Make sure to set the <tt>Caption</tt> property, even if it isn't visible. See updated example script <i>CodeClasses.iss</i> for an example.</li>
       <li>Added new <tt>InitializeBitmapButtonFromIcon</tt> and <tt>GetSHA256OfStream</tt> support functions.</li>
       <li>Added new <tt>InitializeBitmapButtonFromIcon</tt> and <tt>GetSHA256OfStream</tt> support functions.</li>
       <li>Added new <tt>LastBaseNameOrUrl</tt> property to support class <tt>TDownloadWizardPage</tt>. See updated example script <i>CodeDownloadFiles.iss</i> for an example.</li>
       <li>Added new <tt>LastBaseNameOrUrl</tt> property to support class <tt>TDownloadWizardPage</tt>. See updated example script <i>CodeDownloadFiles.iss</i> for an example.</li>
       <li><i>Fix:</i> Event function <tt>CurPageChanged</tt> is now always only triggered when the current page actually changes. Before it was called twice in a row for <tt>wpPreparing</tt> when the script had a <tt>PrepareToInstall</tt> event function which returned a non empty string to instruct Setup to stop.</li>
       <li><i>Fix:</i> Event function <tt>CurPageChanged</tt> is now always only triggered when the current page actually changes. Before it was called twice in a row for <tt>wpPreparing</tt> when the script had a <tt>PrepareToInstall</tt> event function which returned a non empty string to instruct Setup to stop.</li>