Hint Fontsize

[seghele0]

How can I define the font size and color of the text in the hint?
 

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   SpeedButton1.Hint :='First line ...' +#13+ 'Second line ...';
4.   SpeedButton2.Hint :='SPButton2 line one' +#13+ 'Second line ...';
5.   Application.ShowHint:= True;
6.   Application.HintColor:= clYellow;
7.   Application.HintHidePause:= 5000;
8. end;
9.  

[winni]

Hi!

Not such an easy thing to do.
Use this workaround:

Code: Pascal  [Select][+][-]

1. Type
2.  
3. TOKHint = class(THintWindow)
4.      constructor Create(AOwner: TComponent); override;
5.   end;            
6.  
7. constructor TOKHint.Create(AOwner: TComponent);
8. begin
9.   inherited Create(AOwner);
10.   with Canvas.Font do
11.     begin
12.       Alignment := taCenter;
13.       Name  := 'Times New Roman';
14.       Height := 12;
15.       Style := [ fsBold ];
16.       color := clYellow;  
17.     end;
18. end;
19.  
20. procedure TForm1.FormCreate(Sender: TObject);  
21. begin
22. HintWindowClass  := TOKHint;
23. Application.HintColor := clBlue;
24. Application.ShowHint := True;
25. end;

And change the params to your needs.


Winni

[wp]

I checked the following code and found it to work on Windows (did not test others):

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   Screen.HintFont.Color := clWhite;
4.   Screen.HintFont.Name := 'Courier New';
5.   Screen.HintFont.Size := 12;
6.   Screen.HintFont.Style := [fsItalic];
7.   Application.HintColor := clBlack;
8. end;
9.  

[winni]

I checked the following code and found it to work on Windows (did not test others):

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   Screen.HintFont.Color := clWhite;
4.   Screen.HintFont.Name := 'Courier New';
5.   Screen.HintFont.Size := 12;
6.   Screen.HintFont.Style := [fsItalic];
7.   Application.HintColor := clBlack;
8. end;
9.  

Hi!

This worked with Delphi  but it did not work for a long time with fpc/Lazarus.

That's why I created the workaround.
Don't know with which version it changed.

Winni

[wp]

It is been working back to 1.8.6, and maybe for the others of the 1.8.x series, too (don't have them any more). 1.6.4 and older seem to ignore the font settings (at least on Windows).

[seghele0]

Unbelievable how supportive you all are.
This forum is therefore not only for professional programmers, but also for beginners who still have a lot to learn.
 

The example with "constructor" can't increase the font size!
Maybe Lazrus hasn't been modified or enabled yet and it probably only works in Delphi.
This is a challenge for the professionals

Code: Pascal  [Select][+][-]

1. unit Unit1;
2. {$mode objfpc}{$H+}
3. interface
4. uses
5.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls;
6. type
7.   { TForm1 }
8.   TForm1 = class(TForm)
9.     Button1: TButton;
10.     Label1: TLabel;
11.     Label2: TLabel;
12.     SpeedButton1: TSpeedButton;
13.     procedure FormCreate(Sender: TObject);
14.   private
15.   //
16.   public
17.   //
18.   end;
19. var
20.   Form1: TForm1;
21. implementation
22. {$R *.lfm}
23. { TForm1 }
24. Type
25.     TOKHint = class(THintWindow)
26.      constructor Create(AOwner: TComponent); override;
27.   end;
28.  
29. constructor TOKHint.Create(AOwner: TComponent);
30. begin
31.   inherited Create(AOwner);
32.   with Canvas.Font do
33.     begin
34.       Alignment := taCenter;
35.       Name  := 'Arial'; //'Times New Roman';
36.       Height := 18;
37.       Style := [ fsBold ];
38.       color := clBlack; //clYellow;
39.     end;
40. end;
41.  
42. procedure TForm1.FormCreate(Sender: TObject);
43. begin
44.   HintWindowClass  := TOKHint;
45.   Application.HintColor := clYellow;//clBlue;
46.   Application.ShowHint := True;
47. end;
48. end.
49.  

********************************

Next works well.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2. {$mode objfpc}{$H+}
3. interface
4. uses
5.   SysUtils, Variants, Classes, Graphics,
6.   Controls, Forms, Dialogs, StdCtrls, Buttons;
7. type
8.   { TForm1 }
9.   TForm1 = class(TForm)
10.     Label1: TLabel;
11.     SpeedButton1: TSpeedButton;
12.     SpeedButton2: TSpeedButton;
13.     procedure FormCreate(Sender: TObject);
14.   private
15.      //
16.   public
17.      //
18.   end;
19. var
20.   Form1: TForm1;
21. implementation
22. {$R *.lfm}
23. { TForm1 }
24.  
25. procedure TForm1.FormCreate(Sender: TObject);
26. begin
27.    Screen.HintFont.Color := clRed;
28.    Screen.HintFont.Name := 'Arial'; //'Courier New';
29.    Screen.HintFont.Size := 14;
30.    Screen.HintFont.Style := [fsBold];
31.    Application.HintColor := clYellow;
32.    SpeedButton1.Hint :='First line ...' +#13+ 'Second line ...';
33.    SpeedButton2.Hint :='SPButton2 line ...' +#13+ 'Second line ...';
34.    Application.ShowHint:= True;
35. end;
36. end.
37.  

Thanks for the helpful code.

[Lulu]

Hi, re-opening this thread.
On MacOS TApplication.HintColor don't change the hint background color, it remain black: tested on a macos 10.15 virtual machine with Lazarus 2.2.4. Perhaps on newer version of Lazarus this was fixed ?

Searching in the forum, I found the solution posted by Winni. But it don't change the background color.
I added some code to the Winni's solution,to be able to change the background and the font attributes for our beloved hints. We simply have to call

Code: Pascal  [Select][+][-]

1. SetAppHintAttributes(aBackgroundColor,
2.                      aFontColor,
3.                      aFontHeight,
4.                      aFontName,
5.                      aFontStyles,
6.                      aAlign); // TAlignment

Tested on Windows 10, Ubuntu 20.04 and MacOS. It work but with this issue:
  - the first time the colors/font are changed, all is fine
  - when user change more than once the colors/font, the hint is only correctly drawn the second time it is displayed... I don't know why. Any idea ?
I'm aware that changing the hint color several time is not usual. I ask by curiosity.

Attached a demo. Thanks !

EDIT: now the demo work well (see the posts below), the zip file was been updated with the right version.

[seghele0]

 
Thanks.
I'll try it out.

[BrunoK]

Tested on Windows 10, Ubuntu 20.04 and MacOS. It work but with this issue:
  - the first time the colors/font are changed, all is fine
  - when user change more than once the colors/font, the hint is only correctly drawn the second time it is displayed... I don't know why. Any idea ?
I'm aware that changing the hint color several time is not usual. I ask by curiosity.

Attached a demo. Thanks !

The cause is that TApplication.ShowHintWindow does not know the font specifics to calculate the size of the hint window, thus TAppCustomHint.Paint receives a Rect that has been calculated with whatever Font was previously set.
The second time you hover on the hinted control, the font has been set by your paint routine, thus it is then correct.

In the zipped attachement, you find patches that might solve the question.

- Introduction of a THintWindow.GetFontStyle; virtual method. (Hint_GetFontStyle.diff)
- Call to that method before calculating the hint form  position and size, where to patch in file Application_ShowHintWindow_patch.txt (including an unrelated correction).

Your project updated to match the suggested changes.

[Lulu]

@BrunoK: thank you for your explanations and your proposal. But it will be better to not change the Lazarus/LCL code.
However your code and explanations has put me on the right track. This is my final version using Application.AddOnShowHintHandler() to do the trick:

Code: Pascal  [Select][+][-]

1. unit u_hint_attribs;
2.  
3. {$mode ObjFPC}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Graphics, Controls;
9.  
10. // Call as many times as you like to customize your application hints
11. procedure SetAppHintAttributes(aBackgroundColor,
12.                                aFontColor: TColor;
13.                                aFontHeight: integer=0;
14.                                aFontName: string='default';
15.                                aFontStyles: TFontStyles=[];
16.                                aAlign: TAlignment=taLeftJustify);
17.  
18.  
19.  
20. implementation
21. uses Forms, dialogs;
22.  
23. type
24.   { TAppCustomHint }
25.   TAppCustomHint = class(THintWindow)
26.   private class var
27.      _FBackGroundColor,
28.      _FFontColor: TColor;
29.      _FFontHeight: integer;
30.      _FFontName: string;
31.      _FFontStyles: TFontStyles;
32.      _FAlign: TAlignment;
33.   protected
34.   public
35.      constructor Create(AOwner: TComponent); override;
36.      destructor Destroy; override;
37.      procedure Paint; override;
38.      class procedure InitParam(aBackgroundColor,
39.                                aFontColor: TColor;
40.                                aFontHeight: integer;
41.                                aFontName: string;
42.                                aFontStyles: TFontStyles;
43.                                aAlign: TAlignment);
44.  
45.  
46.     procedure ProcessOnShowHintEvent(var HintStr: string; var CanShow: Boolean;
47.                                      var HintInfo: THintInfo);
48.   end;
49.  
50. constructor TAppCustomHint.Create(AOwner: TComponent);
51. begin
52.   inherited Create(AOwner);
53.   Font.Height := _FFontHeight;
54.   Font.Name := _FFontName;
55.   Font.Style := _FFontStyles;
56.  
57.   Application.AddOnShowHintHandler(@ProcessOnShowHintEvent);
58. end;
59.  
60. procedure TAppCustomHint.ProcessOnShowHintEvent(var HintStr: string;
61. var CanShow: Boolean; var HintInfo: THintInfo);
62. begin
63.   Font.Height := _FFontHeight;
64.   Font.Name := _FFontName;
65.   Font.Style := _FFontStyles;
66.   Font.Color := _FFontColor;
67. end;
68.  
69. destructor TAppCustomHint.Destroy;
70. begin
71.   Application.RemoveOnShowHintHandler(@ProcessOnShowHintEvent);
72.   inherited Destroy;
73. end;
74.  
75. procedure TAppCustomHint.Paint;
76. var r: TRect;
77.   ts: TTextStyle;
78. begin
79.   r := ClientRect;
80.   with ts do begin
81.     Alignment := _FAlign;
82.     Layout := tlCenter;
83.     SingleLine := False;
84.     Clipping := False;
85.     Wordbreak := True;
86.     Opaque := False;
87.     SystemFont := False;
88.     RightToLeft := BidiMode<>bdLeftToRight;
89.   end;
90.  
91.   with Canvas do begin
92.     Brush.Style := bsSolid;
93.     Brush.Color := _FBackGroundColor;
94.     FillRect(r);
95.  
96.     Canvas.Font.Color := _FFontColor;
97.     Canvas.Font.Height := _FFontHeight;
98.     Canvas.Font.Name := _FFontName;
99.     Canvas.Font.Style := _FFontStyles;
100.  
101.     TextRect(r, 0, 0, Caption, ts);
102.   end;
103. end;
104.  
105. class procedure TAppCustomHint.InitParam(aBackgroundColor, aFontColor: TColor;
106.    aFontHeight: integer; aFontName: string; aFontStyles: TFontStyles; aAlign: TAlignment);
107. begin
108.   if aFontName = '' then aFontName := 'default';
109.  
110.   _FBackGroundColor := aBackgroundColor;
111.   _FFontColor := aFontColor;
112.   _FFontHeight := aFontHeight;
113.   _FFontName := aFontName;
114.   _FFontStyles := aFontStyles;
115.   _FAlign := aAlign;
116. end;
117.  
118. procedure SetAppHintAttributes(aBackgroundColor, aFontColor: TColor;
119.   aFontHeight: integer; aFontName: string; aFontStyles: TFontStyles; aAlign: TAlignment);
120. begin
121.   TAppCustomHint.InitParam(aBackgroundColor, aFontColor, aFontHeight, aFontName,
122.                            aFontStyles, aAlign);
123.   HintWindowClass := TAppCustomHint;
124. end;
125.  
126. end.

Attached a demo tested on Win10, Ubuntu 20.04 Gtk2 and Macos 10.15.
Thanks again!

[BrunoK]

@BrunoK: thank you for your explanations and your proposal. But it will be better to not change the Lazarus/LCL code.
However your code and explanations has put me on the right track. This is my final version using Application.AddOnShowHintHandler() to do the trick:

Good idea, but there is still a little problem, that I think is corrected with your unit u_hint_attribs; slightly revised.

If you click on one of the 3 Font setters button, the first display (WIN10) of the hint does not show as desired because the afterconstruction, where scaling takes place has not yet been executed.

Adding an afterconstruction override allows to correctly set the font before first showing of the hint.

Code: Pascal  [Select][+][-]

1. unit u_hint_attribs;
2.  
3. {$mode ObjFPC}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Graphics, Controls;
9.  
10. // Call as many times as you like to customize your application hints
11. procedure SetAppHintAttributes(aBackgroundColor,
12.                                aFontColor: TColor;
13.                                aFontHeight: integer=0;
14.                                aFontName: string='default';
15.                                aFontStyles: TFontStyles=[];
16.                                aAlign: TAlignment=taLeftJustify);
17.  
18.  
19.  
20. implementation
21. uses Forms, dialogs;
22.  
23. type
24.   { TAppCustomHint }
25.   TAppCustomHint = class(THintWindow)
26.   private class var
27.      _FBackGroundColor,
28.      _FFontColor: TColor;
29.      _FFontHeight: integer;
30.      _FFontName: string;
31.      _FFontStyles: TFontStyles;
32.      _FAlign: TAlignment;
33.   protected
34.   public
35.      constructor Create(AOwner: TComponent); override;
36.      destructor Destroy; override;
37.      procedure AfterConstruction; override;
38.      procedure Paint; override;
39.      class procedure InitParam(aBackgroundColor,
40.                                aFontColor: TColor;
41.                                aFontHeight: integer;
42.                                aFontName: string;
43.                                aFontStyles: TFontStyles;
44.                                aAlign: TAlignment);
45.  
46.  
47.     procedure ProcessOnShowHintEvent(var HintStr: string; var CanShow: Boolean;
48.                                      var HintInfo: THintInfo);
49.   end;
50.  
51. constructor TAppCustomHint.Create(AOwner: TComponent);
52. begin
53.   inherited Create(AOwner);
54.   Application.AddOnShowHintHandler(@ProcessOnShowHintEvent);
55. end;
56.  
57. procedure TAppCustomHint.ProcessOnShowHintEvent(var HintStr: string;
58. var CanShow: Boolean; var HintInfo: THintInfo);
59. begin
60.   Font.Height := _FFontHeight;
61.   Font.Name := _FFontName;
62.   Font.Style := _FFontStyles;
63.   Font.Color := _FFontColor;
64. end;
65.  
66. destructor TAppCustomHint.Destroy;
67. begin
68.   Application.RemoveOnShowHintHandler(@ProcessOnShowHintEvent);
69.   inherited Destroy;
70. end;
71.  
72. procedure TAppCustomHint.AfterConstruction;
73. var
74.   HintStr: string = '';     // Init the variables to prevent variable not
75.   CanShow: Boolean = True;  // initilized warning
76.   HintInfo: THintInfo;
77. begin
78.   inherited AfterConstruction;
79.   HintInfo:=Default(THintInfo);
80.   ProcessOnShowHintEvent(HintStr, CanShow, HintInfo);
81. end;
82.  
83. procedure TAppCustomHint.Paint;
84. var r: TRect;
85.   ts: TTextStyle;
86. begin
87.   r := ClientRect;
88.   with ts do begin
89.     Alignment := _FAlign;
90.     Layout := tlCenter;
91.     SingleLine := False;
92.     Clipping := False;
93.     Wordbreak := True;
94.     Opaque := False;
95.     SystemFont := False;
96.     RightToLeft := BidiMode<>bdLeftToRight;
97.   end;
98.  
99.   with Canvas do begin
100.     Brush.Style := bsSolid;
101.     Brush.Color := _FBackGroundColor;
102.     FillRect(r);
103.  
104.     Canvas.Font.Color := _FFontColor;
105.     Canvas.Font.Height := _FFontHeight;
106.     Canvas.Font.Name := _FFontName;
107.     Canvas.Font.Style := _FFontStyles;
108.  
109.     TextRect(r, 0, 0, Caption, ts);
110.   end;
111. end;
112.  
113. class procedure TAppCustomHint.InitParam(aBackgroundColor, aFontColor: TColor;
114.    aFontHeight: integer; aFontName: string; aFontStyles: TFontStyles; aAlign: TAlignment);
115. begin
116.   if aFontName = '' then aFontName := 'default';
117.  
118.   _FBackGroundColor := aBackgroundColor;
119.   _FFontColor := aFontColor;
120.   _FFontHeight := aFontHeight;
121.   _FFontName := aFontName;
122.   _FFontStyles := aFontStyles;
123.   _FAlign := aAlign;
124. end;
125.  
126. procedure SetAppHintAttributes(aBackgroundColor, aFontColor: TColor;
127.   aFontHeight: integer; aFontName: string; aFontStyles: TFontStyles; aAlign: TAlignment);
128. begin
129.   TAppCustomHint.InitParam(aBackgroundColor, aFontColor, aFontHeight, aFontName,
130.                            aFontStyles, aAlign);
131.   HintWindowClass := TAppCustomHint;
132. end;
133.  
134. end.
135.  

[Lulu]

If you click on one of the 3 Font setters button, the first display (WIN10) of the hint does not show as desired because the afterconstruction, where scaling takes place has not yet been executed.

Tested also on Win10, with Lazarus 2.2.4 and this problem not occur here. "where scaling takes place" refers to High DPI scaling ? (my test was made without High DPI screen)

EDIT: You right, after some test changing the scaling to 125% and 150% the issue occurs. Thank you to remember me the DPI scaling !

[BrunoK]

EDIT: You right, after some test changing the scaling to 125% and 150% the issue occurs. Thank you to remember me the DPI scaling !

Yeah, I have a 216 DPI (225%) DPI and a 120 DPI (125%) and hints are a nuisance when forms are not on the same monitor. I havent yet figured out how to improve Hints on such a combination.

The usual suspect would be ...

[Lulu]

a method like this

Code: Pascal  [Select][+][-]

1. Application.UseHintWindow(ACustomHintWindow: THintWindow);

will be nice ! 

Here another final try ( ):
- the call to SetAppHintAttributes(...) no longer requires to scale the font height, it is done internally
- added a method to TAppCustomHint to avoid code redondance

Code: Pascal  [Select][+][-]

1. procedure TAppCustomHint._SetFont;
2. begin
3.   Font.Height := ScaleDesignToForm(_FFontHeight);
4.   Font.Name := _FFontName;
5.   Font.Style := _FFontStyles;
6.   Font.Color := _FFontColor;
7. end;
8.  

- simplified the code in AfterConstruction: since it call ProcessOnShowHintEvent and the latter simply calls _SetFont, so one directly call _SetFont.

the project is attached.
Thanks you very much, even if it's tinkering, I've still learnt something !
Regards

[seghele0]

Dear programmers, your serious work gives a wonderful result.
 
It is a useful tool to include in Lazarus.