[Qt] Rotated font

[Hess, Philip J]

I can confirm that Felipe's test code (method 1 in example below) to
rotate a font works with the Qt widgetset on both Windows and OS X.

 

However, the TRotatedLabel control I'm porting to LCL uses a different
way of drawing the rotated text (method 2 below) and this does not work
with the Qt widgetset, although it works fine with the win32 widgetset.
I wonder if the ExtTextOut API function is not fully working with Qt
widgetset yet. Here's the test code, using both methods of drawing
rotated text:

 

 

{$mode objfpc}{$H+}

 

interface

 

uses

  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
LclType, LclIntf;

 

type

 

  { TForm1 }

 

  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);

    procedure FormPaint(Sender: TObject);

  private

    { private declarations }

    MyFont : hFont;

  public

    { public declarations }

  end; 

 

var

  Form1: TForm1; 

 

implementation

 

function CreateRotatedFont(F : TFont; Angle : Integer) : hFont;

  {-create a rotated font based on the font object F}

var

  LF : TLogFont;

begin

  FillChar(LF, SizeOf(LF), #0);

  with LF do begin

    lfHeight           := F.Height;

    lfWidth            := 0;

    lfEscapement       := Angle*10;

    lfOrientation      := 0;

    if fsBold in F.Style then

      lfWeight         := FW_BOLD

    else

      lfWeight         := FW_NORMAL;

    lfItalic           := Byte(fsItalic in F.Style);

    lfUnderline        := Byte(fsUnderline in F.Style);

    lfStrikeOut        := Byte(fsStrikeOut in F.Style);

    lfCharSet          := DEFAULT_CHARSET;

    StrPCopy(lfFaceName, F.Name);

    lfQuality          := DEFAULT_QUALITY;

    {everything else as default}

    lfOutPrecision     := OUT_DEFAULT_PRECIS;

    lfClipPrecision    := CLIP_DEFAULT_PRECIS;

    case F.Pitch of

      fpVariable : lfPitchAndFamily := VARIABLE_PITCH;

      fpFixed    : lfPitchAndFamily := FIXED_PITCH;

    else

      lfPitchAndFamily := DEFAULT_PITCH;

    end;

  end;

  Result := CreateFontIndirect(LF);

end;

 

{ TForm1 }

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  MyFont := CreateRotatedFont(Canvas.Font, 45);

end;

 

procedure TForm1.FormPaint(Sender: TObject);

var

  ARect : TRect;

begin

  SelectObject(Canvas.Handle, MyFont);

  Canvas.TextOut(200, 200, 'Texto para ser escrito');  //Method 1 -
works with Qt

  

  Canvas.Font.Handle := MyFont;

  ARect := ClientRect;

  ExtTextOut(Canvas.Handle, 100, 100, ETO_CLIPPED,

             @ARect, 'Rotated text', 12, nil);  //Method 2 - does not
work with Qt

end;

 

initialization

  {$I Unit1.lrs}

 

end.

 

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/qt/attachments/20061115/6afb1e8e/attachment-0001.html>