[Lazarus] Canvas.TextRec aligns to canvas and not rectangle for tlTop and taLeftJustify.

John Landmesser jmlandmesser at gmx.de
Sun Feb 19 11:18:58 CET 2023


Hi,

add information about lazarus and fpc Version plus OS you are running.

Thats a bugreport  and should be written to
https://gitlab.com/freepascal.org/


I confirm this bug for

Lazarus 2.3.0 (rev main-2_3-2854-g0278edaea3) FPC 3.2.2 x86_64-linux-gtk2

see:

https://i.imgur.com/oJw7tzf.png

regards

John Landmesser

Am 19.02.23 um 08:00 schrieb Russ via lazarus:
> Hi,
>
> When writing text to the canvas using Canvas.TextRec(), using layout
> tlTop and/or alignment  taLeftJustify, the text is aligned to the
> canvas left and top edges instead of those edges of the text
> rectangle. The other layout and alignment cases work correctly.
>
> The sample code below illustrates this for all 9 possible combinations
> of layout and alignment.
>
> Changing lines 1302 and 1304 of canvas.inc fixes this problem:
>    1302:   fRect.Left := X; --> fRect.Left := fRect.Left + X;
>    1304:   fRect.Top := Y;  --> fRect.Top := fRect.Top + Y;
>
> canvas.inc in Lazarus 2.2.4 and trunk are the same.
>
> Regards
> Russ
>
> <code>
>    unit Unit1;
>
>    {$mode objfpc}{$H+}
>
>    interface
>
>    uses
>      Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
>
>    type
>      TForm1 = class(TForm)
>        procedure FormCreate(Sender: TObject);
>        procedure FormPaint(Sender: TObject);
>      end;
>
>    var
>      Form1: TForm1;
>
>    implementation
>
>    {$R *.lfm}
>
>    procedure TForm1.FormCreate(Sender: TObject);
>    begin
>      Width := 300;
>      Height := 300;
>      Position := poDesktopCenter;
>    end;
>
>    procedure TForm1.FormPaint(Sender: TObject);
>    const
>      Txt ='%s'+LineEnding+'%s';
>      Spacing = 75;
>      LeftMargin = 50;
>      TopMargin = 50;
>      VAlign: array[0..2] of TTextLayout = (tlTop, tlCenter, tlBottom);
>      HAlign: array[0..2] of TAlignment = (taLeftJustify, taCenter,
> taRightJustify);
>    var
>      TxtRect: TRect;    // Rectangle used for text.
>      Outline: TRect;    // Enclosing outline rectangle.
>      TxtStyle: TTextStyle;
>      Col, Row: integer;
>      X, Y: Integer;
>      VStr, HStr: string;
>    begin
>      TxtStyle := Default(TTextStyle);
>      TxtStyle.Wordbreak := true;
>      TxtStyle.SystemFont := true;
>
>      TxtRect := TRect.Create(0, 0, 55, 50);
>      Outline := TRect.Create(0, 0, 59, 52);
>
>      for Row := 0 to 2 do begin
>        TxtStyle.Layout := VAlign[Row];
>        WriteStr(VStr, VAlign[Row]);
>        VStr := VStr.Replace('tl', '');
>        Y := TopMargin + Row * Spacing;
>
>        for Col := 0 to 2 do begin
>          WriteStr(HStr, HAlign[Col]);
>          HStr := HStr.Replace('Justify','').Replace('ta','');
>          X := LeftMargin + Col * Spacing;
>          Outline.SetLocation(X, Y);
>          TxtRect.SetLocation(X, Y);
>          TxtStyle.Alignment := HAlign[Col];
>          Canvas.Rectangle(Outline);
>          Canvas.TextRect(TxtRect, 2, 2, Txt.Format(Txt, [VStr, HStr]),
> TxtStyle);
>        end;
>      end;
>    end;
>
>    end.
> </code>
> <form>
>    object Form1: TForm1
>      Left = 728
>      Height = 529
>      Top = 176
>      Width = 545
>      Caption = 'Form1'
>      OnCreate = FormCreate
>      OnPaint = FormPaint
>      LCLVersion = '2.2.4.0'
>    end
> </form>




More information about the lazarus mailing list