Советы по Delphi
Печать повернутого текста
Решение 1
| procedure AngleTextOut(CV: TCanvas; const sText: String; x, y, angle:integer); var LogFont: TLogFont;SaveFont: TFont;begin SaveFont := TFont.Create;SaveFont.Assign(CV.Font);GetObject(SaveFont.Handle, sizeof(TLogFont), @LogFont);with LogFont dobeginlfEscapement := angle *10;lfPitchAndFamily := FIXED_PITCH or FF_DONTCARE;end; {with}CV.Font.Handle := CreateFontIndirect(LogFont);SetBkMode(CV.Handle, TRANSPARENT);CV.TextOut(x, y, sText);CV.Font.Assign(SaveFont);SaveFont.Free;end; |
Решение 2
Вот как я решил эту проблему:
|
|
procedure TextOutVertical(var bitmap: TBitmap; x, y: Integer; s: String); var b1, b2: TBitmap; i, j: Integer;begin with bitmap.Canvas dobeginb1 := TBitmap.Create;b1.Canvas.Font := lpYhFont;b1.Width := TextWidth(s) + 1;b1.Height := TextHeight(s) + 1;b1.Canvas.TextOut(1, 1, s); b2 := TPackedBitmap.Create;b2.Width := TextHeight(s);b2.Height := TextWidth(s);for i := 0 to b1.Width - 1 dofor j := 0 to b1.Height dob2.Canvas.Pixels[j, b2.Height + 1 - i] := b1.Canvas.Pixels[i, j];Draw(x, y, b2);b1.Free;b2.Free;endend; |
Решение 3
Некоторое время я делал так: я создавал шрифт, выбирал его в DC ...
| function CreateMyFont(degree: Integer): HFONT; begin CreateMyFont := CreateFont(-30, 0, degree, 0, 0,0, 0, 0, 1, OUT_TT_PRECIS,0, 0, 0, szFontName);end; |
.... и затем использовал любую функцию рисования для вывода текста.
Решение 4
Приведенное выше решение (1) очень медленно, так как требует рисования текста и содержит, на мой взгляд, неэффективный метод вращения. Попробуйте взамен это:
| procedure TForm1.TextUp(aRect:tRect;aTxt:String); var LFont: TLogFont; hOldFont, hNewFont: HFont; begin GetObject(Canvas.Font.Handle,SizeOf(LFont),Addr(LFont));LFont.lfEscapement := 900;hNewFont := CreateFontIndirect(LFont);hOldFont := SelectObject(Canvas.Handle,hNewFont);Canvas.TextOut(aRect.Left+2,aRect.Top,aTxt);hNewFont := SelectObject(Canvas.Handle,hOldFont);DeleteObject(hNewFont);end; |
[000207]
