Browse Source

Expose TBitmapButton to [Code]. Todo: doc & whatsnew (including InitializeBitmapButtonFromIcon).

Martijn Laan 1 month ago
parent
commit
6a4ed20bcb

+ 17 - 11
Examples/CodeClasses.iss

@@ -27,11 +27,6 @@ begin
   MsgBox('You clicked the button!', mbInformation, mb_Ok);
 end;
 
-procedure BitmapImageOnClick(Sender: TObject);
-begin
-  MsgBox('You clicked the image!', mbInformation, mb_Ok);
-end;
-
 procedure FormButtonOnClick(Sender: TObject);
 var
   Form: TSetupForm;
@@ -132,6 +127,7 @@ var
   CheckListBox, CheckListBox2: TNewCheckListBox;
   FolderTreeView: TFolderTreeView;
   BitmapImage, BitmapImage2, BitmapImage3: TBitmapImage;
+  BitmapButton: TBitmapButton;
   BitmapFileName: String;
   RichEditViewer: TRichEditViewer;
 begin
@@ -353,8 +349,6 @@ begin
   BitmapImage := TBitmapImage.Create(Page);
   BitmapImage.AutoSize := True;
   BitmapImage.Bitmap.LoadFromFile(BitmapFileName);
-  BitmapImage.Cursor := crHand;
-  BitmapImage.OnClick := @BitmapImageOnClick;
   BitmapImage.Parent := Page.Surface;
 
   BitmapImage2 := TBitmapImage.Create(Page);
@@ -364,8 +358,6 @@ begin
   BitmapImage2.Left := BitmapImage.Width + 10;
   BitmapImage2.Height := 2*BitmapImage.Height;
   BitmapImage2.Width := 2*BitmapImage.Width;
-  BitmapImage2.Cursor := crHand;
-  BitmapImage2.OnClick := @BitmapImageOnClick;
   BitmapImage2.Parent := Page.Surface;
 
   BitmapImage3 := TBitmapImage.Create(Page);
@@ -375,10 +367,24 @@ begin
   BitmapImage3.Height := 4*BitmapImage.Height;
   BitmapImage3.Width := 4*BitmapImage.Width;
   BitmapImage3.Anchors := [akLeft, akTop, akRight, akBottom];
-  BitmapImage3.Cursor := crHand;
-  BitmapImage3.OnClick := @BitmapImageOnClick;
   BitmapImage3.Parent := Page.Surface;
 
+  { TBitmapButton }
+
+  Page := CreateCustomPage(Page.ID, 'Custom wizard page controls', 'TBitmapButton (Press Alt to see focus rectangle)');
+
+  BitmapButton := TBitmapButton.Create(Page);
+  BitmapButton.AutoSize := True;
+  BitmapButton.Bitmap := BitmapImage.Bitmap;
+  BitmapButton.Center := True;
+  BitmapButton.Caption := 'Show Message'; { For accesibility }
+  BitmapButton.Hint := 'TBitmapButton is an accessible version of TBitmapImage';
+  BitmapButton.ShowHint := True;
+  BitmapButton.Width := 2*BitmapButton.Width;
+  BitmapButton.Cursor := crHand;
+  BitmapButton.OnClick := @ButtonOnClick;
+  BitmapButton.Parent := Page.Surface;
+
   { TRichViewer }
 
   Page := CreateCustomPage(Page.ID, 'Custom wizard page controls', 'TRichViewer');

+ 1 - 0
Projects/Setup.dpr

@@ -75,6 +75,7 @@ uses
   BidiUtils in '..\Components\BidiUtils.pas',
   PathFunc in '..\Components\PathFunc.pas',
   BidiCtrls in '..\Components\BidiCtrls.pas',
+  BitmapButton in '..\Components\BitmapButton.pas',
   BitmapImage in '..\Components\BitmapImage.pas',
   FolderTreeView in '..\Components\FolderTreeView.pas',
   NewCheckListBox in '..\Components\NewCheckListBox.pas',

+ 1 - 0
Projects/Setup.dproj

@@ -148,6 +148,7 @@
         <DCCReference Include="..\Components\BidiUtils.pas"/>
         <DCCReference Include="..\Components\PathFunc.pas"/>
         <DCCReference Include="..\Components\BidiCtrls.pas"/>
+        <DCCReference Include="..\Components\BitmapButton.pas"/>
         <DCCReference Include="..\Components\BitmapImage.pas"/>
         <DCCReference Include="..\Components\FolderTreeView.pas"/>
         <DCCReference Include="..\Components\NewCheckListBox.pas"/>

+ 20 - 1
Projects/Src/Compiler.ScriptClasses.pas

@@ -229,13 +229,31 @@ begin
   end;
 end;
 
-procedure RegisterBitmapImage_C(Cl: TPSPascalCompiler);
+procedure RegisterBitmapButton_C(Cl: TPSPascalCompiler);
 begin
   Cl.AddTypeS('TAlphaFormat', '(afIgnored, afDefined, afPremultiplied)');
   with Cl.FindClass('TBitmap') do
   begin
     RegisterProperty('AlphaFormat', 'TAlphaFormat', iptrw);
   end;
+  with Cl.AddClassN(CL.FindClass('TCustomControl'),'TBitmapButton') do
+  begin
+    RegisterProperty('Anchors', 'TAnchors', iptrw);
+    RegisterProperty('AutoSize', 'Boolean', iptrw);
+    RegisterProperty('BackColor', 'TColor', iptrw);
+    RegisterProperty('Caption', 'String', iptrw);
+    RegisterProperty('Center', 'Boolean', iptrw);
+    RegisterProperty('Bitmap', 'TBitmap', iptrw);
+    RegisterProperty('ReplaceColor', 'TColor', iptrw);
+    RegisterProperty('ReplaceWithColor', 'TColor', iptrw);
+    RegisterProperty('Stretch', 'Boolean', iptrw);
+    RegisterProperty('OnClick', 'TNotifyEvent', iptrw);
+    RegisterProperty('OnDblClick', 'TNotifyEvent', iptrw);
+  end;
+end;
+
+procedure RegisterBitmapImage_C(Cl: TPSPascalCompiler);
+begin
   with Cl.AddClassN(CL.FindClass('TGraphicControl'),'TBitmapImage') do
   begin
     RegisterProperty('Anchors', 'TAnchors', iptrw);
@@ -663,6 +681,7 @@ begin
   RegisterCustomFolderTreeView_C(Cl);
   RegisterFolderTreeView_C(Cl);
   RegisterStartMenuFolderTreeView_C(Cl);
+  RegisterBitmapButton_C(Cl);
   RegisterBitmapImage_C(Cl);
   RegisterBidiCtrls_C(Cl);
 

+ 8 - 2
Projects/Src/Setup.ScriptClasses.pas

@@ -25,7 +25,7 @@ uses
   uPSR_stdctrls, uPSR_extctrls, uPSR_comobj,
   NewStaticText, NewCheckListBox, NewProgressBar, RichEditViewer,
   ExtCtrls, UIStateForm, Setup.SetupForm, Setup.MainForm, Setup.WizardForm, Shared.SetupTypes, PasswordEdit,
-  FolderTreeView, BitmapImage, NewNotebook, Setup.ScriptDlg, BidiCtrls,
+  FolderTreeView, BitmapButton, BitmapImage, NewNotebook, Setup.ScriptDlg, BidiCtrls,
   Setup.UninstallProgressForm;
 
 type
@@ -138,12 +138,17 @@ end;
 procedure TBitmapAlphaFormat_W(Self: TBitmap; const T: TAlphaFormat); begin Self.AlphaFormat := T; end;
 procedure TBitmapAlphaFormat_R(Self: TBitmap; var T: TAlphaFormat); begin T := Self.AlphaFormat; end;
 
-procedure RegisterBitmapImage_R(Cl: TPSRuntimeClassImporter);
+procedure RegisterBitmapButton_R(Cl: TPSRuntimeClassImporter);
 begin
   with Cl.FindClass('TBitmap') do
   begin
     RegisterPropertyHelper(@TBitmapAlphaFormat_R, @TBitmapAlphaFormat_W, 'AlphaFormat');
   end;
+  Cl.Add(TBitmapButton);
+end;
+
+procedure RegisterBitmapImage_R(Cl: TPSRuntimeClassImporter);
+begin
   Cl.Add(TBitmapImage);
 end;
 
@@ -431,6 +436,7 @@ begin
     RegisterCustomFolderTreeView_R(Cl);
     RegisterFolderTreeView_R(Cl);
     RegisterStartMenuFolderTreeView_R(Cl);
+    RegisterBitmapButton_R(Cl);
     RegisterBitmapImage_R(Cl);
     RegisterBidiCtrls_R(Cl);
 

+ 6 - 1
Projects/Src/Setup.ScriptFunc.pas

@@ -21,7 +21,7 @@ implementation
 uses
   Windows,
   Forms, SysUtils, Classes, Graphics, ActiveX, Generics.Collections,
-  uPSUtils, PathFunc, ISSigFunc, ECDSA, BrowseFunc, MD5, SHA1, SHA256, BitmapImage, PSStackHelper,
+  uPSUtils, PathFunc, ISSigFunc, ECDSA, BrowseFunc, MD5, SHA1, SHA256, BitmapButton, BitmapImage, PSStackHelper,
   Shared.Struct, Setup.ScriptDlg, Setup.MainFunc, Shared.CommonFunc.Vcl,
   Shared.CommonFunc, Shared.FileClass, SetupLdrAndSetup.RedirFunc,
   Setup.Install, SetupLdrAndSetup.InstFunc, Setup.InstFunc, Setup.InstFunc.Ole,
@@ -1814,6 +1814,11 @@ var
       if ErrorCode <> 0 then
         raise Exception.Create(Win32ErrorString(ErrorCode));
     end);
+    RegisterScriptFunc('INITIALIZEBITMAPBUTTONFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
+    begin
+      var AscendingTrySizes := Stack.GetIntArray(PStart-4);
+      Stack.SetBool(PStart, TBitmapButton(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
+    end);
     RegisterScriptFunc('INITIALIZEBITMAPIMAGEFROMICON', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
     begin
       var AscendingTrySizes := Stack.GetIntArray(PStart-4);

+ 1 - 0
Projects/Src/Shared.ScriptFunc.pas

@@ -539,6 +539,7 @@ initialization
     'function CreateCallback(Method: AnyMethod): Longword;',
     'function IsDotNetInstalled(const MinVersion: TDotNetVersion; const MinServicePack: Cardinal): Boolean;',
     'function IsMsiProductInstalled(const UpgradeCode: String; const PackedMinVersion: Int64): Boolean;',
+    'function InitializeBitmapButtonFromIcon(const BitmapButton: TBitmapButton; const IconFilename: String; const BkColor: TColor; const AscendingTrySizes: TArrayOfInteger): Boolean;',
     'function InitializeBitmapImageFromIcon(const BitmapImage: TBitmapImage; const IconFilename: String; const BkColor: TColor; const AscendingTrySizes: TArrayOfInteger): Boolean;',
     'procedure Extract7ZipArchive(const ArchiveFileName, DestDir: String; const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress);',
     'procedure ExtractArchive(const ArchiveFilename, DestDir, Password: String; const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress);',