| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Про компоненты без Canvas [D5, D6, Win95/98, WinME, NT4, Win2k, WinXP]
kiborg © (2002-05-20 12:24:00)Уважаемые мастера, у меня один вопрос. Как нарисовать что-то на компоненте, у которого нет Canvas? Можно с примерчиком?
liho26 (2002-05-22 07:23:00) [1]После нудного копания я так и не нашел HWND в меню... Есть другие варианты?
Игорь Шевченко (2002-05-21 15:02:00) [2]ACanvas.Handle := GetWindowDC(MainMenu1.Items.Handle);
Handle имеет тип HMENU, а не HWND, и GetWindowDC для него не сработает :-))
liho26 (2002-05-21 11:54:00) [3]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 спасибо. Сейчас займусь изучением :)
liho26 (2002-05-21 09:15:00) [4]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 спасибо. Сейчас займусь изучением :)
liho26 (2002-05-21 07:55:00) [5]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 спасибо. Сейчас займусь изучением :)
Alx2 (2002-05-21 07:42:00) [6]>MishGan (20.05.02 18:22)
А я-то загнался :))
Song (2002-05-20 20:05:00) [7]Забыл добавить
ReleaseDC() и
Canvas.Free
MishGan (2002-05-20 18:22:00) [8]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;
Song (2002-05-20 14:29:00) [9]>Song! Я пробовал. Не пролучилось....
А как пробовал-то?
Alx2 (2002-05-20 14:17:00) [10]Пример использования:
В Event"ах, в Object Inspector, у этого компонента будет событие OnPaint. В него передается Canvas, на котором можно будет рисовать:
procedure TForm1.PaintedEdit1Paint(aCanvas: TCanvas);
begin
aCanvas.Brush.Color := clGreen;
aCanvas.FillRect(PaintedEdit1.ClientRect); // Просто покрасим все зеленым :)
end;
Alx2 (2002-05-20 14:12:00) [11]Вот, накидал на скорую руку:
Попробуй проинсталлировать этот 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.
liho26 (2002-05-20 13:37:00) [12]Alx2. Видимо ты прав. Но, вот беда, я в написании компонента не силен :( Увы, увы! Но видимо паинт предется переписывать. Это наверное единственное, что я еще не пробовал делать :)
Alx2 (2002-05-20 13:33:00) [13]Тут, скорее всего, придется новый компонент нарисовать (потомок нужного) и в нем ручками (например, по мотивам модуля controls) обработать WM_Paint. Думаю, это не очень сложно...
liho26 (2002-05-20 13:13:00) [14]Song! Я пробовал. Не пролучилось....
Song (2002-05-20 13:03:00) [15]Я хотел сказать, что рисовать можно через DC
liho26 (2002-05-20 12:57:00) [16]Song! А причем тут иконки?
Song (2002-05-20 12:49:00) [17]http://delphi.mastak.ru/cgi-bin/forum.pl?look=1&id=1021835666&n=0
liho26 (2002-05-20 12:41:00) [18]Конкретно, надо перерисовать TEdit - раскрасить его "под себя", включая и бордюрчик. Также TMainMenu. Его, собственно я уже перерисовал заново, но 1 пиксельный бордюр никак немогу ни удалить, ни перекрасить...
Alx2 (2002-05-20 12:33:00) [19]А какой компонент?
liho26 (2002-05-20 12:28:00) [20]Нету... :(
| |
Страницы: 