Форум: "Основная";
Текущий архив: 2002.06.03;
Скачать: [xml.tar.bz2];
Вниз
Про компоненты без 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;
← →
Song (2002-05-20 20:05) [16]Забыл добавить
ReleaseDC() и
Canvas.Free
← →
Alx2 (2002-05-21 07:42) [17]>MishGan (20.05.02 18:22)
А я-то загнался :))
← →
liho26 (2002-05-21 07:55) [18]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) [19]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 11:54) [20]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 спасибо. Сейчас займусь изучением :)
← →
Игорь Шевченко (2002-05-21 15:02) [21]ACanvas.Handle := GetWindowDC(MainMenu1.Items.Handle);
Handle имеет тип HMENU, а не HWND, и GetWindowDC для него не сработает :-))
← →
liho26 (2002-05-22 07:23) [22]После нудного копания я так и не нашел HWND в меню... Есть другие варианты?
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.06.03;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.006 c
