{-------------------------------------------------------------------------------
UNIT - GTKLABEL
This unit fixes a bug in the standard TLabel. See:
https://forum.lazarus.freepascal.org/index.php?topic=53544.msg396318#msg396318
With a standard TLabel, when autosize = true (the default), descenders in the
caption get chopped. It is a reported bug, not fixed as of Mar 2021.
Autosizing labels are required as label captions will change, dependent on function and
language.
GTKLabel defines a TLabeLGTK that will autosize on caption change WITHOUT chopping the descenders.
V1.0 - 03 Mar 2021
-------------------------------------------------------------------------------}
unit GTKlabel;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, StdCtrls, Graphics;
type
TLabelGTK = class(TLabel)
const
hAdd = 2; //add to text height of caption
wAdd = 10; //add to text width of caption
private
procedure setWidth;
procedure setHeight;
public
constructor Create(TheOwner: TComponent); override;
procedure setCaption(CaptionStr : string);
end;
implementation
{-------------------------------------------------------------------------------
TLABELGTK.CONSTRUCTOR
Constructor that inherits the TLabel constructor and sets autosize = false and sets
vertical alignment = centre.
V1.0 - 03 Mar 2021
-------------------------------------------------------------------------------}
constructor TLabelGTK.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
AutoSize:= false;
Layout:= tlCenter;
end;
{-------------------------------------------------------------------------------
TLABELGTK.SETWIDTH (private)
Calculates the width of a TLabel caption in pixels by writing it to a bitmap canvas and using the
TextWidth function to determine width which is then written to the TLabel width.
The width of the label is increased by wAdd.
Used by: TLabelGTK.setCaption
V1.0 - 03 Mar 2021
-------------------------------------------------------------------------------}
procedure TLabelGTK.setWidth;
var
bmp: TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.Canvas.Font.Assign(Font);
Width:= bmp.Canvas.TextWidth(Caption) + wAdd;
finally
bmp.Free;
end;
end;
{-------------------------------------------------------------------------------
TLABELGTK.SETHEIGHT (private)
Calculates the height of a TLabel caption in pixels by writing it to a bitmap canvas and using the
TextHeight function to determine height which is then written to the TLabel height.
The height of the label is increased by hAdd.
Used by: TLabelGTK.setCaption
V1.0 - 03 Mar 2021
-------------------------------------------------------------------------------}
procedure TLabelGTK.setHeight;
var
bmp: TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.Canvas.Font.Assign(Font);
Height:= bmp.Canvas.TextHeight(Caption) + hAdd;
finally
bmp.Free;
end;
end;
{-------------------------------------------------------------------------------
TLABELGTK.SETCAPTION (public)
Set the caption of a TLabelGTK. Use this to set/change a caption instead of MyLabel.Caption:= 'something'.
Use MyLabel.setCaption('something').
Uses setWidth and setHeight to 'autosize' the caption.
Used by: general
V1.0 - 03 Mar 2021
-------------------------------------------------------------------------------}
procedure TLabelGTK.setCaption(CaptionStr : string);
begin
Caption:= CaptionStr;
setWidth;
setHeight;
end;
end.