Вывод текста под углом

← →
_Guest_ (2008-02-13 12:39) [0]

Не могу понять причину того, что одни шрифты (Arial, Times New Roman) удается обработать приведенным ниже кодом, а другие (Bookshelf Symbol 7, Animals, SbisEAN-13) - нет

var
MFont : HFont;
LogFont : TLogFont;
FontName : ShortString;
ACanvas : TCanvas;
TV : TPoint;
i : Integer;
TextObj : String;

begin
TV := Point(100, 100);
TextObj := "123";
with ACanvas do
begin
GetObject(Font.Handle, SizeOf(TLogFont), @LogFont);
with LogFont do
begin
lfHeight := 20;
lfWidth := 20;
lfEscapement := 0;
lfWeight := FW_NORMAL;
lfCharSet := RUSSIAN_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;
lfPitchAndFamily := DEFAULT_PITCH;
for i := 1 to LF_FACESIZE - 1 do lfFaceName[i] := #0;
for i := 1 to Length(FontName) do lfFaceName[i - 1] := FontName[i];
end;
MFont := CreateFontIndiRect(LogFont);
Font.Handle := MFont;
{messagedlg(Font.Name, mtinformation, [mbOk], 0);}
TextOut(TV.X, TV.Y, TextObj);
end;
DeleteObject(MFont);
end;

причем, если вместо всего просто сделать:
Acanvas.Font.Name := FontName;
TextOut(TV.X, TV.Y, TextObj);

Все выведется, но нет возможности изменять угол наклона текста, а
это необходимо.
Если кто знает причину, подскажите, буду очень благодарен.

← →
clickmaker © (2008-02-13 12:44) [1]

> for i := 1 to LF_FACESIZE - 1 do lfFaceName[i] := #0;
> for i := 1 to Length(FontName) do lfFaceName[i -
> 1] := FontName[i];

что это?!
и где там наклон?

← →
_Guest_ (2008-02-13 12:51) [2]

Наклон в lfEscapement := 0; Для примера он 0.
а это:
for i := 1 to LF_FACESIZE - 1 do lfFaceName[i] := #0; for i := 1 to Length(FontName) do lfFaceName[i - 1] := FontName[i]
а какая собственно разница, каким образом символы в символьный массив попадают? Можно StrNew + StrDispose кто-то StrPCopy использует, разве это принципиально?

← →
clickmaker © (2008-02-13 12:55) [3]

> разве это принципиально?

и каждый раз так пишешь, когда надо строку скопировать?
а почему не сразу на Asm"e?

← →
_Guest_ (2008-02-13 13:00) [4]

> и каждый раз так пишешь, когда надо строку скопировать?а
> почему не сразу на Asm"e?

нет не каждый, обычно я пишу XX := StrNew(PChar(YY)); , а это кусок очень старой программы. Надеюсь я ответил на Ваш вопрос? А то очнень уж хочется по теме что-нибудь услышать.

← →
clickmaker © (2008-02-13 13:06) [5]

все работает

procedure TForm1.Button1Click(Sender: TObject);
var
MFont : HFont;
LogFont : TLogFont;
FontName : ShortString;
ACanvas : TCanvas;
TV : TPoint;
i : Integer;
TextObj : String;
begin
TV := Point(10, 10);
TextObj := "123";
with PaintBox1.Canvas do
begin
//GetObject(Font.Handle, SizeOf(TLogFont), @LogFont); нафига???
with LogFont do
begin
lfHeight := 20;
lfWidth := 20;
lfEscapement := 40;
lfWeight := FW_NORMAL;
lfCharSet := RUSSIAN_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;
lfPitchAndFamily := DEFAULT_PITCH;
lstrcpy(lfFaceName, "Bookshelf Symbol 7");
end;
MFont := CreateFontIndiRect(LogFont);
Font.Handle := MFont;
TextOut(TV.X, TV.Y, Font.Name);
end;
DeleteObject(MFont);
end;

← →
Григорьев Антон © (2008-02-13 13:08) [6]

> Bookshelf Symbol 7, Animals, SbisEAN-13

А это точно TrueType шрифты? Если растровые, то их нельзя повернуть по определению.

← →
clickmaker © (2008-02-13 13:11) [7]

правда, могут быть проблемы с уникодными шрифтами
бо, как известно, VCL с ним не дружит
Используй тогда не TCanvas.TextOut, а АПИшные DrawTextW, ExtTextOutW

← →
_Guest_ (2008-02-13 13:13) [8]

> все работает

С одной стороны здорово. А с другой: значит у меня глюк. Только он какой-то устойчивый - на десятках машин с разными ОС и так далее.

А если не секрет, что выводится в результате?
Что-то похожее на "MmN" только со всякими прибамбасами?

т.е. как-то так

lfCharSet := DEFAULT_CHARSET;

...

TextOutW(PaintBox1.Canvas.Handle, TV.X, TV.Y, "Some text", 9);

← →
_Guest_ (2008-02-13 13:35) [10]

> lfCharSet := DEFAULT_CHARSET;

Ага, слона то я и не заметил. Спасибо, огромное. У меня, правда, загнулись надписи по-русски, но теперь хоть ясно куда копать. Еще раз спасибо.

> загнулись надписи по-русски

а в Bookshelf Symbol 7 есть русские буквы?

← →
_Guest_ (2008-02-13 14:08) [12]

> а в Bookshelf Symbol 7 есть русские буквы?

Нет, эта надпись не единственная в канве. Просто для каждого шрифта надо задавать свой чарсет, а я решая локальную задачу, влепил всем русский и забыл. Спасибо, дальше понятно, что делать.

Вывод текста под углом Найти похожие ветки