Merge pull request #41 from digao-dalpiaz/dpi-and-fmx-font

Dpi and fmx font

Author: digao-dalpiaz

CompInstall.ini

@@ -3,7 +3,7 @@ IniVersion=2
 
 [General]
 Name=Digao Dalpiaz - Dam component
-Version=6.4
+Version=6.5
 DelphiVersions=XE3;XE4;XE5;XE6;XE7;XE8;10;10.1;10.2;10.3;10.4;11;12
 Packages=DamCommonPackage;DamPackage_VCL;DamPackage_FMX;DamDesignPackage_VCL;DamDesignPackage_FMX
 AddLibrary=1

README.md

@@ -36,13 +36,18 @@
 
 ## What's New
 
-- 02/23/2024 (Version 6.4)
+- 03/10/2024 (Version 6.5)
 
-   - Fixed included files path in Design packages (the files was referencing "Design" folder twice).
+   - New ButtonsFont property (and ButtonsFontColor when FMX).
+   - Fixed adjusting DPI when first display dialog in VCL.
 
 <details>
   <summary>Click here to view the entire changelog</summary>
 
+- 02/23/2024 (Version 6.4)
+
+   - Fixed included files path in Design packages (the files was referencing "Design" folder twice).
+
 - 02/22/2024 (Version 6.3)
 
    - Fixed Lazarus Design Package compiling.
@@ -435,37 +440,41 @@ MsgInfo('This is a %p message number %p at time %p', ['test', 123, Now]);
 
 ## TDam properties
 
+`ButtonsColor: TColor` = Define background color of buttons area on message dialog.
+
+`ButtonsFont: TFont` = Defines the text font of dialog buttons
+
+`ButtonsFontColor: TAlphaColor` = Defines the text font color of dialog buttons *(Only available in FMX environment)*
+
 `CenterButtons: Boolean` = Define if the buttons at message form will be aligned at center. If this property is false, the buttons will be aligned at right of form.
 
 `DamDefault: Boolean` = Defines if this TDam will be used to fire quick messages (please read Quick Messages section). You only can have one defined as Default in the application.
 
 `DamUnitName: String` = Specify the unit name to be created with all message methods in the project folder. Do not specify file extension, because the component will complete the name automatically with ".pas" extension.
 
+`DialogBorder: Boolean` = Defines if the window of message dialog will contain borders. You can disable this property to create modern dialog themes.
+
 `DialogPosition: TDamDlgPosition` = Defines the dialog form start position:
 - dpScreenCenter: center the window based on the screen
 - dpMainFormCenter: center the window based on the main window
 - dpActiveFormCenter: center the window based on the active window
 
-`DialogBorder: Boolean` = Defines if the window of message dialog will contain borders. You can disable this property to create modern dialog themes.
-
 `HandleExceptions: Boolean` = Defines this TDam to handle all application exceptions, showing the error message with the same dialog as all other Dam messages. Only one TDam can be set to handle exceptions in the application.
 
+`HideIcon: Boolean` = If True, the icon on the message dialog will be suppressed.
+
 `Images: TCustomImageList` = Allows you to set an ImageList, using tag `<img:idx>` in the message text, where `idx` is image index.
 
 `Language: TDamLanguage` = Defines the language used by message buttons and message form title. *When you place an instance of TDam component, this property will be initialized according to the system current language. If there is no language available according to the system, English language will be set. This property has no default value, precisely because it should store the language being defined.*
 
+`MessageColor: TColor` = Define background color of message area on message dialog.
+
 `MessageFont: TFont` = Defines the text font of messages
 
 `MessageFontColor: TAlphaColor` = Defines the text font color of messages *(Only available in FMX environment)*
 
 `PlaySounds: Boolean` = Enable system sounds when showing messages of Warning, Question and Error kinds.
 
-`MessageColor: TColor` = Define background color of message area on message dialog.
-
-`ButtonsColor: TColor` = Define background color of buttons area on message dialog.
-
-`HideIcon: Boolean` = If True, the icon on the message dialog will be suppressed.
-
 ## TDam events
 
 `OnLinkClick(Sender: TObject; Msg: TDamMsg; const Target: string; var Handled: Boolean; var CloseMsg: Boolean; var MsgResult: TDamMsgRes)`

Source/Vcl.DamDialog.pas

@@ -48,6 +48,17 @@ implementation
 type
   TBoxComps = {$IFDEF FMX}TRectangle{$ELSE}TPanel{$ENDIF};
 
+  TBmp =
+  {$IFDEF FPC}
+    Graphics
+  {$ELSE}
+    {$IFDEF FMX}
+    FMX.{$IFDEF USE_NEW_UNITS}Graphics{$ELSE}Types{$ENDIF}
+    {$ELSE}
+    Vcl.Graphics
+    {$ENDIF}
+  {$ENDIF}.TBitmap;
+
 type
   TFrmDamDialogDyn = class(TForm)
   private
@@ -62,6 +73,8 @@   TFrmDamDialogDyn = class(TForm)
     DamResult: TDamMsgRes;
     LangStrs: TDamLanguageDefinition;
 
+    VirtualBmp: TBmp;
+
     procedure BuildControls;
 
     function GetCurrentMonitorWidth: Integer;
@@ -90,11 +103,11 @@   TFrmDamDialogDyn = class(TForm)
     procedure OnBtnClick(Sender: TObject);
   public
     constructor CreateNew; reintroduce;
+    destructor Destroy; override;
   end;
 
 const
   BRD_SPACE = 8;
-  BTN_HEIGHT = 25;
   {$IFDEF FMX}
   BRUSH_KIND_NONE = TBrushKind.{$IFDEF USE_NEW_ENUMS}None{$ELSE}bkNone{$ENDIF};
   {$ENDIF}
@@ -114,30 +127,6 @@ function GetControlRight(C: TControl): TPixels;
   Result := GetControlLeft(C) + C.Width;
 end;
 
-function CalcButtonWidth(Btn: TButton): TPixels;
-type TBmp =
-  {$IFDEF FPC}
-    Graphics
-  {$ELSE}
-    {$IFDEF FMX}
-    FMX.{$IFDEF USE_NEW_UNITS}Graphics{$ELSE}Types{$ENDIF}
-    {$ELSE}
-    Vcl.Graphics
-    {$ENDIF}
-  {$ENDIF}.TBitmap;
-var
-  B: TBmp;
-begin
-  B := TBmp.Create{$IFDEF USE_FMX_OLD_ENV}(1, 1){$ENDIF};
-  try
-    B.Canvas.Font.Assign(Btn.Font);
-
-    Result := Max(B.Canvas.TextWidth(Btn.{$IFDEF FMX}Text{$ELSE}Caption{$ENDIF})+20, 75);
-  finally
-    B.Free;
-  end;
-end;
-
 //
 
 constructor TFrmDamDialogDyn.CreateNew;
@@ -150,6 +139,14 @@ constructor TFrmDamDialogDyn.CreateNew;
   {$IFDEF USE_DPICHANGE}
   OnAfterMonitorDpiChanged := OnAfterDpiChanged;
   {$ENDIF}
+
+  VirtualBmp := TBmp.Create{$IFDEF USE_FMX_OLD_ENV}(1, 1){$ENDIF};
+end;
+
+destructor TFrmDamDialogDyn.Destroy;
+begin
+  VirtualBmp.Free;
+  inherited;
 end;
 
 function RunDamDialog(DamMsg: TDamMsg; const aText: string): TDamMsgRes;
@@ -169,6 +166,9 @@ function RunDamDialog(DamMsg: TDamMsg; const aText: string): TDamMsgRes;
     F.BuildButtons;
 
     F.SetIcon;
+    {$IFDEF USE_DPICHANGE}
+    F.ScaleForCurrentDPI;
+    {$ENDIF}
     F.CalcFormBounds;
 
     F.ShowModal;
@@ -183,6 +183,7 @@ function RunDamDialog(DamMsg: TDamMsg; const aText: string): TDamMsgRes;
 procedure TFrmDamDialogDyn.BuildControls;
 var
   Action: TAction;
+  BtnHeight: TPixels;
 begin
   ActionList := TActionList.Create(Self);
 
@@ -226,8 +227,11 @@ procedure TFrmDamDialogDyn.BuildControls;
   {$ENDIF}
   LbMsg.GeneratePlainText := True;
 
+  VirtualBmp.Canvas.Font.Assign(DamMsg.Dam.ButtonsFont);
+  BtnHeight := VirtualBmp.Canvas.TextHeight('A')+8;
+
   BoxButtons := TBoxComps.Create(Self);
-  BoxButtons.Height := BRD_SPACE+BTN_HEIGHT+BRD_SPACE;
+  BoxButtons.Height := BRD_SPACE+BtnHeight+BRD_SPACE;
   BoxButtons.Parent := Self;
   {$IFDEF FMX}
   BoxButtons.Align := TAlignLayout.{$IFDEF USE_NEW_ENUMS}Bottom{$ELSE}alBottom{$ENDIF};
@@ -239,7 +243,7 @@ procedure TFrmDamDialogDyn.BuildControls;
   {$ENDIF}
 
   BoxFloatBtns := TBoxComps.Create(Self);
-  BoxFloatBtns.SetBounds(0, BRD_SPACE, 0, BTN_HEIGHT);
+  BoxFloatBtns.SetBounds(0, BRD_SPACE, 0, BtnHeight);
   BoxFloatBtns.Parent := BoxButtons;
   {$IFDEF FMX}
   BoxFloatBtns.Stroke.Kind := BRUSH_KIND_NONE; //remove border
@@ -249,10 +253,11 @@ procedure TFrmDamDialogDyn.BuildControls;
   {$ENDIF}
 
   BtnHelp := TSpeedButton.Create(Self);
-  BtnHelp.SetBounds(BRD_SPACE, BRD_SPACE, BTN_HEIGHT{width same as height}, BTN_HEIGHT);
+  BtnHelp.SetBounds(BRD_SPACE, BRD_SPACE, VirtualBmp.Canvas.TextWidth('?')+20, BtnHeight);
   BtnHelp.Parent := BoxButtons;
   BtnHelp.{$IFDEF FMX}Text{$ELSE}Caption{$ENDIF} := '?';
   BtnHelp.OnClick := BtnHelpClick;
+  BtnHelp.Font.Assign(DamMsg.Dam.ButtonsFont);
 end;
 
 procedure TFrmDamDialogDyn.LoadTextProps(const MsgText: string);
@@ -358,6 +363,7 @@ procedure TFrmDamDialogDyn.BuildButtons;
   X: TPixels;
   Btn: TButton;
   Names: array[1..3] of string;
+  BtnText: string;
 begin
   case DamMsg.Buttons of
     dbOne, dbOK: NumButtons := 1;
@@ -386,13 +392,22 @@ procedure TFrmDamDialogDyn.BuildButtons;
     X := 0;
     for I := 1 to NumButtons do
     begin
+      BtnText := Names[I];
+
       Btn := TButton.Create(Self);
       Btn.Parent := BoxFloatBtns;
-      Btn.{$IFDEF FMX}Text{$ELSE}Caption{$ENDIF} := Names[I];
+      Btn.{$IFDEF FMX}Text{$ELSE}Caption{$ENDIF} := BtnText;
       Btn.OnClick := OnBtnClick;
       Btn.Tag := I;
-
-      Btn.SetBounds(X, 0, CalcButtonWidth(Btn), BoxFloatBtns.Height);
+      {$IFDEF FMX}
+      Btn.TextSettings.Font.Assign(DamMsg.Dam.ButtonsFont);
+      Btn.TextSettings.FontColor := DamMsg.Dam.ButtonsFontColor;
+      Btn.StyledSettings := [];
+      {$ELSE}
+      Btn.Font.Assign(DamMsg.Dam.ButtonsFont);
+      {$ENDIF}
+
+      Btn.SetBounds(X, 0, Max(VirtualBmp.Canvas.TextWidth(BtnText)+20, 75), BoxFloatBtns.Height);
       X := X + Btn.Width + BRD_SPACE;
 
       ButtonsList.Add(Btn);