Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Написать под углом...

WInAPi Lamer © (2003-06-01 14:55:00)
Нужно нарисовать на дельфиХ.Канву текст под произвольным углом, млжет кто знает.
Просьба на существующий везде пример

procedure CanvasSetTextAngle(c: TCanvas; d: single);var LogRec: TLOGFONT; ( c.Font.Handle,SizeOf(LogRec)
Нужно нарисовать на дельфиХ.Канву текст под произвольным углом, млжет кто знает.
Просьба на существующий везде пример

procedure CanvasSetTextAngle(c: TCanvas; d: single);var LogRec: TLOGFONT; { Информация о шрифте }
begin {Читаем текущюю инф. о шрифте }
GetObject(c.Font.Handle,SizeOf(LogRec) ,Addr(LogRec) ); { Изменяем угол }
LogRec.lfEscapement := round(d*10); { Устанавливаем новые параметры }
c.Font.Handle := CreateFontIndirect(LogRec);
end;
не ссылаться
он у мя не работает :(

WInAPi Lamer (2003-07-23 16:43:00) [1]

ПАСИБО

.:Noname:. (2003-06-11 15:28:00) [2]
Для того чтобы вывести текст под углом, вытянуть или сжать его нужно воспользоваться структурой LOGFONT. Здесь показаны не все ее возможности, но, на мой взгляд, самые интересные.

procedure TForm1.FormPaint(Sender: TObject);
var
lf: TLogFont;
begin
FillChar(lf, SizeOf(lf), 0);
with lf do begin
// Высота буквы
lfHeight := 15;

// Ширина буквы
lfWidth := 20;

// Угол наклона в десятых градуса

lfEscapement := 100;

// Жирность 0..1000, 0 - по умолчанию
lfWeight := 1000;

// Курсив
lfItalic := 0;

// Подчеркнут
lfUnderline := 1;

// Зачеркнут
lfStrikeOut := 1;

// CharSet
lfCharSet := RUSSIAN_CharSet;

// Название шрифта
StrCopy(lfFaceName, "Arial");
end;
with Form1.Canvas do begin
FillRect(ClipRect);

Font.Handle := CreateFontIndirect(lf);
( 0, 100, "It is a text string")
Для того чтобы вывести текст под углом, вытянуть или сжать его нужно воспользоваться структурой LOGFONT. Здесь показаны не все ее возможности, но, на мой взгляд, самые интересные.

procedure TForm1.FormPaint(Sender: TObject);
var
lf: TLogFont;
begin
FillChar(lf, SizeOf(lf), 0);
with lf do begin
// Высота буквы
lfHeight := 15;

// Ширина буквы
lfWidth := 20;

// Угол наклона в десятых градуса

lfEscapement := 100;

// Жирность 0..1000, 0 - по умолчанию
lfWeight := 1000;

// Курсив
lfItalic := 0;

// Подчеркнут
lfUnderline := 1;

// Зачеркнут
lfStrikeOut := 1;

// CharSet
lfCharSet := RUSSIAN_CharSet;

// Название шрифта
StrCopy(lfFaceName, "Arial");
end;
with Form1.Canvas do begin
FillRect(ClipRect);

Font.Handle := CreateFontIndirect(lf);
TextOut(0, 100, "It is a text string");
end;
end;

vladnt (2003-06-02 08:15:00) [3]

Canvas.Font.name:="MS Sans Serif";// не работает
а с остальными шрифтами идет.

Плохой человек (2003-06-01 15:38:00) [4]

Ссылаюсь на это же:

procedure MyRotateText(CV : TCanvas; sText:String;
X, Y, Angle:Integer); {угол в градусах}
VAR LogFont : TLogFont;
BEGIN
GetObject(CV.Font.Handle, SizeOf(TLogFont), @LogFont);
LogFont.lfEscapement:= Angle*10;
CV.Font.Handle := CreateFontIndirect(LogFont);
CV.TextOut(X,Y,sText);
END;

Или ты не всё написал, или твоя процедурка глюканутая. Вот ещё - ты пахаешь под ДельфиХ, значит, можешь собрать простое изображение, написать на него текст обычными методами канвы и вывести изображение под углом.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »