VPF::Вывести многострочный текст - Форум программистов

Illusion Dolphin

Дата 1.4.2005, 16:40 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

Собственно, всё просто: нужно вывести многострочный текст под углом. Пока ничего не выходит (а ручками разбивать на строки и выводить со смещением как-то некрасиво).

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

Girder

Дата 2.4.2005, 00:29 (ссылка)

(нет голосов)

Загрузка ...

Лентяй 2

Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 2
Всего: 155

Не понятно... куда ты его хочеш выводить... smile

ну да ладно smile

Код

procedure StrRotated(Win:THandle;Font:HFont;Str:string;Ang:Extended);
var nXF,oXF:TXForm;
    s:TStrings;
    i:integer;
    r:TSize;
    DC:HDC;
    fNew,fOld:HFont;
begin
 DC:=GetDC(Win);
 fNew:=SendMessage(Win,WM_GETFONT,0,0);
 if fNew=0 then fNew:=Font;
 fOld:=SelectObject(DC,fNew);
 s:=TStringList.Create;
 s.Text:=Str;
 SetGraphicsMode(DC,GM_Advanced);
 GetWorldTransform(DC,oXF);
 nXF.eM11:=Cos(Ang*Pi/180);
 nXF.eM22:=Cos(Ang*Pi/180);
 nXF.eM12:=Sin(Ang*Pi/180);
 nXF.eM21:=-Sin(Ang*Pi/180);
 nXF.eDX:=0;
 nXF.eDY:=0;
 ModifyWorldTransform(DC,nXF,MWT_LEFTMULTIPLY);
 for i:=0 to s.Count-1 do
  begin
   GetTextExtentPoint32(DC,PChar(s.Strings[i]),Length(s.Strings[i]),r);
   TextOut(DC,0,i*r.cy,PChar(s.Strings[i]),Length(s.Strings[i]));
  end;
 SetWorldTransform(DC,oXF);
 s.Free;
 SelectObject(DC,fOld);
 ReleaseDC(Win,DC);
end;

Использование: StrRotated(Memo1.Handle,Memo1.Font.Handle,Memo1.text,20);
или
StrRotated(Form1.Handle,Form1.Font.Handle,Memo1.text,20);

--------------------

Как слышим, так и пишим.
Истина где-то там...

Illusion Dolphin

Дата 2.4.2005, 17:16 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

Цитата

а ручками разбивать на строки и выводить со смещением как-то некрасиво

Значит остановились именно на этом варианте smile

(просто хотелочь что-то вроде DrawText, чтобы сразу с флагом переноса...)
Просто было неохоро разбивать на строки, ибо у меня текст выводится кроме всего прочего в определённом Rect, выходить за который низя - нужно переносить. Значит пошёл я разбивать вручную и переночить лишние словечки smile

НО! Нужно вывести текст БЕЗ ФОНА, т.е. как со стилем bsclear. Что-то пока не нахожу способа...

--------------------

Girder

Дата 2.4.2005, 18:57 (ссылка)

(нет голосов)

Загрузка ...

Лентяй 2

Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 2
Всего: 155

Добавь: SetBkMode(DC, TRANSPARENT)

К примеру:

Код

...
 s.Text:=Str;
 SetBkMode(DC, TRANSPARENT);
 SetGraphicsMode(DC,GM_Advanced);
...

--------------------

Как слышим, так и пишим.
Истина где-то там...

Illusion Dolphin

Дата 2.4.2005, 19:58 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

Girder, да, я уже нашёл smile

При этом даже не оьязательно юзать TextOut и GetTextExtentPoint32 - DrawText класно справляется с этим. Только слышал об ограничении ModifyWorldTransform в винь98... Если это так. то жаль :/

--------------------

Girder

Дата 3.4.2005, 02:06 (ссылка)

(нет голосов)

Загрузка ...

Лентяй 2

Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 2
Всего: 155

Цитата(Illusion @ 2.4.2005, 20:58)

Если это так. то жаль :/

Ну... есть ещё же способы smile

Например, для текста(только текста) smile

Код

procedure TForm1.Button1Click(Sender: TObject);
var LF:TLogFont;
    FontNew,FontOld:HFont;
    DC:HDC;
    s:string;
begin
 DC:=GetDC(Form1.Handle);
 SetBKMode(DC,Transparent);
 GetObject(Form1.Canvas.Font.Handle,SizeOf(LF),@LF);
 LF.lfEscapement:=-20*10;
 LF.lfOrientation:=-20*10;
 FillChar(LF.lfFaceName,Length(LF.lfFaceName),#0);
 LF.lfFaceName:='Microsoft Sans Serif'; // :)
 FontNew:=CreateFontIndirect(LF);
 FontOld:=SelectObject(DC,FontNew);
 s:='VVGGTTLL';
 TextOut(DC,0,0,PChar(s),Length(s));
 SelectObject(DC,FontOld);
 ReleaseDC(Form1.Handle,DC);
 DeleteObject(FontNew);
end;

PS: Не для каждого шрифта smile

Это сообщение отредактировал(а) Girder - 3.4.2005, 03:42

--------------------

Как слышим, так и пишим.
Истина где-то там...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »