Вниз
Скачать: CL | DM;

Не могу изменить направление шрифта дважды   Найти похожие ветки 

 
BMouradov   (2006-04-01 18:28) [0]

Уважаемые господа! Подскажите, почему не получается изменить направление шрифта дважды? Рисую на pb(PainBox):

type TMyFont = object(TGraphicTool)
    public
      procedure SetHandle(H: THandle);
    end;
    procedure TMyFont.SetHandle;
    begin
      fHandle := H;
    end;

procedure ...;
var LogRec: TLOGFONT;
begin
 pb.Canvas.Font.FontName := "Arial";
 GetObject(pb.Canvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));

 LogRec.lfEscapement := 300;
 TMyFont(pb.Canvas.Font^).SetHandle(CreateFontIndirect(LogRec));
 pb.Canvas.TextOut(10, 10, "123");

 LogRec.lfEscapement := 900;
 TMyFont(pb.Canvas.Font^).SetHandle(CreateFontIndirect(LogRec));
 pb.Canvas.TextOut(20, 20, "123");

По идее, должны выйти две надписи, под углом 30 и 90. Но обе выходят под 30.

Пробовал и более развернуто, но не помогло:

var hNewFont, hOldFont: Cardinal;

 hOldFont := TMyFont(pb.Canvas.Font^).GetHandle;
 GetObject(pb.Canvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));
 LogRec.lfEscapement := 300;
 hNewFont := CreateFontIndirect(LogRec);
 TMyFont(pb.Canvas.Font^).SetHandle(hNewFont);
 pb.Canvas.TextOut(10, 10, "123");
 TMyFont(pb.Canvas.Font^).SetHandle(hOldFont);
 DeleteObject(hNewFont);

//и то же самое для 900.

Помогите, пожалуйста! В VCL подобная конструкция работает, только там вспомогательный класс не нужен.


 
ECM ©   (2006-04-01 18:52) [1]

Всё получается...
Не надо  всё так усложнять..
:))

procedure TForm1.PaintBox1Paint(Sender: PControl; DC: HDC);
begin
 with Sender.Canvas^ do begin
   Brush.Color := clGray;
   FillRect(Sender.ClientRect);
   Font.FontOrientation := 300;
   TextOut(10,10,"123");
   Font.FontOrientation := 900;
   TextOut(30,30,"123");
 end;
end;


В результате видим две написи первая повернута на 30 гр. вторая на 90


 
BMouradov   (2006-04-01 18:56) [2]

Класс!! Спасибо большое!



Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.03 c
15-1167249518
Yegorchic
2006-12-27 22:58
2007.01.21
Песня "Снежинка"


15-1167660045
vrem
2007-01-01 17:00
2007.01.21
Что почём-2 :)


1-1164716831
DelphiLexx
2006-11-28 15:27
2007.01.21
DBGridEh и EndElipses


2-1168031918
Riply
2007-01-06 00:18
2007.01.21
GetMem or New ? That is a question ! :))


6-1155850398
Victor!
2006-08-18 01:33
2007.01.21
Проблемма с TIdTCPClient.ReadLn в Delphi 7




   Наверх