Хочу вывести текст под углом, дела так
void __fastcall TForm1::Button1Click(TObject *Sender)
{
LOGFONT lf;
GetObject(Form1->Canvas->Font->Handle,sizeof(lf),&lf);
lf.lfEscapement = 900;
lf.lfOrientation = 900;
lf.lfWeight = FW_NORMAL;
Form1->Canvas->Font->Handle = CreateFontIndirect(&lf);
Form1->Canvas->TextOutA(50,50,"TEST");
DeleteObject(Form1->Canvas->Font->Handle);
}
Ну вот загвостка почемуто срабатывает только со второго раза, Т.е. в первый раз рисует как обычно, а при вызове в второй раз рисует уже как надо.
Не пойму в чем загвоздка.
Builder 6. Win XP pro.
Здравствуйте, DenisKDA, Вы писали:
DKD>Хочу вывести текст под углом, дела так
...
DKD>Form1->Canvas->Font->Handle = CreateFontIndirect(&lf);
Так делать ИМХО нельзя
Вот что я использую, надеюсь переведешь в билдер
procedure FreeTextOut(Canvas: TCanvas; X, Y, A: Integer; S: string);
var
OldFont, NewFont: hFont;
lf: TLogFont;
begin
with lf, Canvas do
begin
{Устанавливаем параметры шрифта.
Все параметры, кроме двух из текущего шрифта}
lfHeight:= Font.Height;
lfWidth:= 0;
lfEscapement:= A * 10; {Угол наклона строки}
lfOrientation:= A * 10; {Угол наклона символа}
if fsBold in Font.Style then
lfWeight:= FW_BOLD
else
lfWeight:= FW_NORMAL;
lfItalic:= Byte(fsItalic in Font.Style);
lfUnderline:= Byte(fsUnderline in Font.Style);
lfStrikeOut:= Byte(fsStrikeOut in Font.Style);
lfCharSet:= DEFAULT_CHARSET;
StrPCopy(lfFaceName, Font.Name);
lfQuality:= DEFAULT_QUALITY;
lfOutPrecision:= OUT_DEFAULT_PRECIS;
lfClipPrecision:= CLIP_DEFAULT_PRECIS;
lfPitchAndFamily:= DEFAULT_PITCH;
end;
{Создаем шрифт}
NewFont:= CreateFontIndirect(lf);
{Выбираем в контекст}
OldFont:= SelectObject(Canvas.Handle, NewFont);
{Выводим текст}
Canvas.TextOut(X, Y, S);
{Выбираем старый шрифт в контекст}
SelectObject(Canvas.Handle, OldFont);
{Удаляем созданный}
DeleteObject(NewFont);
end;
... << RSDN@Home 1.1.4 beta 5 rev 405 >> <<silent>>
Спасибо! А глюк состоял в том, что ширифт "MS Sans Serif" нехотел писаться под углом как только поставил другой сразу все заработало, почему так я и немонял. Какая в принципе разница какой у меня ширифт стоит.
Здравствуйте, alive, Вы писали:
A>Здравствуйте, DenisKDA, Вы писали:
DKD>>Хочу вывести текст под углом, дела так
A>A>...
DKD>>Form1->Canvas->Font->Handle = CreateFontIndirect(&lf);
A>
A>Так делать ИМХО нельзя
A>Вот что я использую, надеюсь переведешь в билдер
A>A>procedure FreeTextOut(Canvas: TCanvas; X, Y, A: Integer; S: string);
A>var
A> OldFont, NewFont: hFont;
A> lf: TLogFont;
A>begin
A> with lf, Canvas do
A> begin
A> {Устанавливаем параметры шрифта.
A> Все параметры, кроме двух из текущего шрифта}
A> lfHeight:= Font.Height;
A> lfWidth:= 0;
A> lfEscapement:= A * 10; {Угол наклона строки}
A> lfOrientation:= A * 10; {Угол наклона символа}
A> if fsBold in Font.Style then
A> lfWeight:= FW_BOLD
A> else
A> lfWeight:= FW_NORMAL;
A> lfItalic:= Byte(fsItalic in Font.Style);
A> lfUnderline:= Byte(fsUnderline in Font.Style);
A> lfStrikeOut:= Byte(fsStrikeOut in Font.Style);
A> lfCharSet:= DEFAULT_CHARSET;
A> StrPCopy(lfFaceName, Font.Name);
A> lfQuality:= DEFAULT_QUALITY;
A> lfOutPrecision:= OUT_DEFAULT_PRECIS;
A> lfClipPrecision:= CLIP_DEFAULT_PRECIS;
A> lfPitchAndFamily:= DEFAULT_PITCH;
A> end;
A> {Создаем шрифт}
A> NewFont:= CreateFontIndirect(lf);
A> {Выбираем в контекст}
A> OldFont:= SelectObject(Canvas.Handle, NewFont);
A> {Выводим текст}
A> Canvas.TextOut(X, Y, S);
A> {Выбираем старый шрифт в контекст}
A> SelectObject(Canvas.Handle, OldFont);
A> {Удаляем созданный}
A> DeleteObject(NewFont);
A>end;
A>
Здравствуйте, DenisKDA, Вы писали:
DKD>Спасибо! А глюк состоял в том, что ширифт "MS Sans Serif" нехотел писаться под углом как только поставил другой сразу все заработало, почему так я и немонял. Какая в принципе разница какой у меня ширифт стоит.
Шрифт должен быть TrueType.
... << RSDN@Home 1.1.4 beta 5 rev 405 >> <<Queen — [A Day At The Races] Teo Torriatte (Let Us Cling To>>
