rotated text
lazarus / 13-General

----------------------------------------------------------------------
Anonymous · 2006-03-24 18:52

Hi,
I need painting a rotated text on the canvas. Delphi use TLogFont. How
does make it in Lazarus?

----------------------------------------------------------------------
bruyere · 2006-11-16 16:19

Il y a un exemple de rotation de text sous delphi qui s'appelle
"TTProj.dpr"que je voulais porter sous lazarus pour comprendre le
principe mais je n'y arrive pas si quelq'un a une idée je suis aussi
preneur pour faire une rotation de text avec lazarus .

merci d'avance . :cry:

----------------------------------------------------------------------
SergKam · 2006-11-22 16:18

see WinApi.

----------------------------------------------------------------------
felipemdc · 2006-11-22 21:12

This function will create a rotated Font:

Note: Put LCLIntf on your uses clause but *don´t* put Windows.

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;

Here is how to use the font function:

procedure TForm2.FormCreate(Sender: TObject);
begin
 MyFont := CreateRotatedFont(Canvas.Font, 45);
end;

And how to paint a rotated text:

procedure TForm2.FormPaint(Sender: TObject);
begin
 SelectObject(Canvas.Handle, MyFont);
 Canvas.TextOut(200, 200, 'Texto para ser escrito');
end;

Currently this will work on Win32, Windows CE and Qt interfaces. This
isn´t implemented for Gtk interface yet.