Про компоненты без Canvas

← →
kiborg (2002-05-20 12:24) [0]

Уважаемые мастера, у меня один вопрос. Как нарисовать что-то на компоненте, у которого нет Canvas? Можно с примерчиком?

← →
Игорь Шевченко © (2002-05-20 12:27) [1]

А метод рисования есть?

← →
KilkennyCat © (2002-05-20 12:28) [2]

Ну, насколько я понимаю, нужно воспользоваться функциями ВинАПИ, где вместо канвы указывается хэндл объекта.

← →
liho26 © (2002-05-20 12:28) [3]

Нету... :(

← →
Alx2 © (2002-05-20 12:33) [4]

А какой компонент?

← →
liho26 © (2002-05-20 12:41) [5]

Конкретно, надо перерисовать TEdit - раскрасить его "под себя", включая и бордюрчик. Также TMainMenu. Его, собственно я уже перерисовал заново, но 1 пиксельный бордюр никак немогу ни удалить, ни перекрасить...

← →
Song © (2002-05-20 12:49) [6]

http://delphi.mastak.ru/cgi-bin/forum.pl?look=1&id=1021835666&n=0

← →
liho26 © (2002-05-20 12:57) [7]

Song! А причем тут иконки?

← →
Song © (2002-05-20 13:03) [8]

Я хотел сказать, что рисовать можно через DC

← →
liho26 © (2002-05-20 13:13) [9]

Song! Я пробовал. Не пролучилось....

← →
Alx2 © (2002-05-20 13:33) [10]

Тут, скорее всего, придется новый компонент нарисовать (потомок нужного) и в нем ручками (например, по мотивам модуля controls) обработать WM_Paint. Думаю, это не очень сложно...

← →
liho26 © (2002-05-20 13:37) [11]

Alx2. Видимо ты прав. Но, вот беда, я в написании компонента не силен :( Увы, увы! Но видимо паинт предется переписывать. Это наверное единственное, что я еще не пробовал делать :)

← →
Alx2 © (2002-05-20 14:12) [12]

Вот, накидал на скорую руку:
Попробуй проинсталлировать этот unit. Компонент появится на вкладке Templates (вкладку можно поменять, здесь найдешь где именно)
unit PaintedEdit; interface uses Windows, Messages, SysUtils, Classes, Controls, StdCtrls, graphics; type TPaintEvent = procedure (aCanvas : TCanvas) of object; TPaintedEdit = class(TEdit) private FOnPaint: TPaintEvent; procedure WMPaint(var Message: TWMPaint); message WM_Paint; procedure SetOnPaint(const Value: TPaintEvent); { Private declarations } protected { Protected declarations } public { Public declarations } constructor Create(aOwner : TComponent) ; override; published { Published declarations } property OnPaint : TPaintEvent read FOnPaint write SetOnPaint; end; procedure Register; implementation constructor TPaintedEdit.Create(aOwner: TComponent); begin FOnPaint := Nil; inherited; end; procedure TPaintedEdit.SetOnPaint(const Value: TPaintEvent); begin FOnPaint := Value; end; procedure TPaintedEdit.WMPaint(var Message: TWMPaint); var DC, MemDC: HDC; MemBitmap, OldBitmap: HBITMAP; PS: TPaintStruct; Canvas : TCanvas; begin if Message. DC <> 0 then begin if not (csCustomPaint in ControlState) and (ControlCount = 0) then inherited else PaintHandler(Message); end else begin DC := GetDC(0); MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom); ReleaseDC(0, DC); MemDC := CreateCompatibleDC(0); OldBitmap := SelectObject(MemDC, MemBitmap); try DC := BeginPaint(Handle, PS); Perform(WM_ERASEBKGND, MemDC, MemDC); Message.DC := MemDC; WMPaint(Message); if @FOnPaint<>Nil then begin Canvas := TCanvas.Create; try Canvas.Handle := MemDC; OnPaint(Canvas); finally Canvas.Free; end; end; Message.DC := 0; BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY); EndPaint(Handle, PS); finally SelectObject(MemDC, OldBitmap); DeleteDC(MemDC); DeleteObject(MemBitmap); end; end; end; procedure Register; begin RegisterComponents("Templates", [TPaintedEdit]); end; end.

← →
Alx2 © (2002-05-20 14:17) [13]

Пример использования:
В Event"ах, в Object Inspector, у этого компонента будет событие OnPaint. В него передается Canvas, на котором можно будет рисовать:

procedure TForm1.PaintedEdit1Paint(aCanvas: TCanvas);
begin
aCanvas.Brush.Color := clGreen;
aCanvas.FillRect(PaintedEdit1.ClientRect); // Просто покрасим все зеленым :)
end;

← →
Song © (2002-05-20 14:29) [14]

>Song! Я пробовал. Не пролучилось....

А как пробовал-то?

← →
MishGan (2002-05-20 18:22) [15]

2 kiborg. Не вижу проблемы:

procedure TForm1.Button1Click(Sender: TObject);
var
Canvas: TCanvas;
begin
Canvas := TCanvas.Create;
Canvas.Handle := GetWindowDC(Edit1.Handle);
Canvas.LineTo(Edit1.Width, Edit1.Height);
end;

Забыл добавить
ReleaseDC() и
Canvas.Free

>MishGan (20.05.02 18:22)
А я-то загнался :))

MishGan, спасибо! Заработало. Одной проблемой стало меньше. :) Теперь остался еще вопрос - перерисовать меню. Убрать бордюр, который остается.
Я ток что пробовал порисовать на менюхе с помощью вот такого кода

procedure TForm1.New1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); begin ACanvas.Handle := GetWindowDC(MainMenu1.Items.Handle); Acanvas.Brush.Color:=clwhite; Acanvas.Rectangle(0,0,40,10); end;
Но прога ругается, говорит, что нельзя рисовать на канвасе. Что я не так делаю?

Alx2 спасибо. Сейчас займусь изучением :)

MishGan, спасибо! Заработало. Одной проблемой стало меньше. :) Теперь остался еще вопрос - перерисовать меню. Убрать бордюр, который остается.
Я ток что пробовал порисовать на менюхе с помощью вот такого кода

procedure TForm1.New1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); begin ACanvas.Handle := GetWindowDC(MainMenu1.Items.Handle); Acanvas.Brush.Color:=clwhite; Acanvas.Rectangle(0,0,40,10); end;

Но прога ругается, говорит, что нельзя рисовать на канвасе. Что я не так делаю?

Alx2 спасибо. Сейчас займусь изучением :)

MishGan, спасибо! Заработало. Одной проблемой стало меньше. :) Теперь остался еще вопрос - перерисовать меню. Убрать бордюр, который остается.
Я ток что пробовал порисовать на менюхе с помощью вот такого кода

procedure TForm1.New1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
begin
ACanvas.Handle := GetWindowDC(MainMenu1.Items.Handle);
Acanvas.Brush.Color:=clwhite;
Acanvas.Rectangle(0,0,40,10);
end;

Но прога ругается, говорит, что нельзя рисовать на канвасе. Что я не так делаю?

Alx2 спасибо. Сейчас займусь изучением :)

ACanvas.Handle := GetWindowDC(MainMenu1.Items.Handle);

Handle имеет тип HMENU, а не HWND, и GetWindowDC для него не сработает :-))

После нудного копания я так и не нашел HWND в меню... Есть другие варианты?

Про компоненты без Canvas Найти похожие ветки