[Solved] Laz3.0rc1 -- Font rendering problem in TStatusBar

[jipété]

Hi,

No code, simply some components and values in Objects' Inspector so, here is the .lfm file :

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

1. object Form1: TForm1
2.   Left = 272
3.   Height = 101
4.   Top = 186
5.   Width = 603
6.   Caption = 'Form1'
7.   ClientHeight = 101
8.   ClientWidth = 603
9.   Color = clTeal
10.   LCLVersion = '3.0.0.1'
11.   object StatusBar1: TStatusBar
12.     Left = 0
13.     Height = 26
14.     Top = 75
15.     Width = 603
16.     AutoSize = False
17.     Font.Height = -16
18.     Font.Name = 'DejaVu Serif'
19.     Panels = <>
20.     ParentColor = False
21.     ParentFont = False
22.     SimpleText = 'Font broken in TStatusBar (same setup as TPanel : Font.Size = 12, Name = DejaVu Serif)'
23.   end
24.   object Panel1: TPanel
25.     Left = 12
26.     Height = 26
27.     Top = 14
28.     Width = 576
29.     Alignment = taLeftJustify
30.     Caption = 'Font working fine in TPanel   (here size 12, Font.Name is DejaVu Serif)'
31.     Color = clCream
32.     Font.Height = -16
33.     Font.Name = 'DejaVu Serif'
34.     ParentBackground = False
35.     ParentColor = False
36.     ParentFont = False
37.     TabOrder = 1
38.     UseDockManager = False
39.   end
40.   object Button1: TButton
41.     Left = 8
42.     Height = 29
43.     Top = 44
44.     Width = 580
45.     AutoSize = True
46.     Caption = 'Font working fine in TButton (here size 12, Font.Name is DejaVu Serif)'
47.     Font.Height = -16
48.     Font.Name = 'DejaVu Serif'
49.     ParentFont = False
50.     TabOrder = 2
51.   end
52. end

See the attached file.

Thanks,

[jipété]

Oops, I've forgotten important informations :
OS Debian Bullseye 11.7 64bits
WidgetSet : gtk2
Desktop Manager : LXDE

[AlexTP]

Ubuntu 20.04. gtk2.
I see that TStatusBar don't respect Font.Size (and .Name) property at all.
Lazarus: last from 'main'.

[paweld]

you reported this earlier: https://forum.lazarus.freepascal.org/index.php/topic,60834.0.html

[dsiders]

Ubuntu 20.04. gtk2.
I see that TStatusBar don't respect Font.Size (and .Name) property at all.
Lazarus: last from 'main'.

On Windows, it uses an assigned Font when UseSystemFont is set to False. I can't speak for other platforms...

[jipété]

Hello,

Ubuntu 20.04. gtk2.
I see that TStatusBar don't respect Font.Size (and .Name) property at all.

Thanks for your reply.

You're right, see attached img.

In the TMemo one can see the font choosen for TStatusBar, and

[On Windows, it uses an assigned Font when UseSystemFont is set to False. I can't speak for other platforms...

Setting True (default) of False doesn't change the display.

you reported this earlier: https://forum.lazarus.freepascal.org/index.php/topic,60834.0.html

Forgotten that, surely because one year after, the problem is still alive, even if the post was tagged "Solved".
Tomorrow I'll study again your link.
--
jp

[jipété]

Hello,

Thank you so much for bringing this thread back to me, which I completely forgot about...

The solution to my problem is to add a procedure (remember : "stb" is the name of my StatusBar) :

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

1. procedure TForm1.stbDrawPanel(StatusBar: TStatusBar;
2.   Panel: TStatusPanel; const Rect: TRect);
3. var
4.   w, h, x, y: Integer;
5.   r: TRect;
6. begin
7.   r.Create(Rect);
8.   if StatusBar.SizeGrip and (Panel.Index = StatusBar.Panels.Count - 1) then
9.     r.Width := r.Width - GetSystemMetrics(SM_CXVSCROLL) - GetSystemMetrics(SM_CXBORDER);
10.   StatusBar.Canvas.Brush.Color := Form1.Color;
11.   StatusBar.Canvas.Font := StatusBar.Font;
12.   case (Panel.Index mod 3) of
13.     0: StatusBar.Canvas.Font.Color := clBlue;
14.     1: StatusBar.Canvas.Font.Color := clGreen;
15.     2: StatusBar.Canvas.Font.Color := clRed;
16.   end;
17.   StatusBar.Canvas.FillRect(r);
18.   w := StatusBar.Canvas.TextWidth(Panel.Text);
19.   case Panel.Alignment of
20.     taLeftJustify : x := r.Left + 2;
21.     taRightJustify: x := r.Right - 2 - w;
22.     taCenter: x := r.Left + (r.Width - w) div 2;
23.   end;
24.   h := StatusBar.Canvas.TextHeight(Panel.Text);
25.   y := r.Top + (r.Height - h) div 2;
26.   StatusBar.Canvas.TextOut(x, y, Panel.Text);
27. end;

and modify the FormCreate procedure as follows:

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

1. procedure TForm1.FormCreate(Sender: TObject);
2. var
3.   aSimpleText: string;
4. begin
5.   aSimpleText := 'A Simple Text';
6.   stb.AutoSize := False;
7.   stb.Height := 32;
8.   stb.Font.Name := 'Aria Script SSi';
9.   stb.Font.Size := 16;
10.   stb.SimplePanel:=False; // needs that, even if only one panel
11. {//using that causes the Panels[0] to be badly aligned and with a wrong color
12.   with stb.Panels.Add do begin
13.     Style := psOwnerDraw;
14.     Width := Form1.Width;
15. // a try   Alignment := taLeftJustify;
16.     Text := aSimpleText;
17.   end;
18.   stb.Panels[0].Alignment := taLeftJustify; // still bad }
19.   stb.Panels.Add;
20.   stb.Panels[0].Style := psOwnerDraw;
21.   stb.Panels[0].Width := Form1.Width;
22.   stb.Panels[0].Alignment := taLeftJustify;
23.   stb.Panels[0].Text := aSimpleText;
24.   stb.OnDrawPanel := @stbDrawPanel;
25. end;

And it works !
img good_statusbar

But caution with the lines I've commented out : see img bad_statusbar.

Big thanks to paweld for refreshing my memory
Have a nice day,