Как рисовать на форме поверх всего ?

← →
b/@. © (2009-07-14 16:45) [0]

Добрый день.

Подскажите пожалуйста - можно ли, а если можно то как, рисовать на форме поверх всех элементов?

Вот к примеру такой код рисует рамочку
procedure TForm1.FormPaint(Sender: TObject); begin Canvas.Rectangle(10, 10 , ClientWidth - 10, ClientHeight - 10); end;
но при этом, на всех контролах, таких как листбоксы, кнопки, групбоксы и т.п. рамочка не рисуется.

Есть ли простые способы рисовать на форме напрямую ?

← →
Palladin © (2009-07-14 17:01) [1]

ага... на десктопе рисовать...

← →
Rouse_ © (2009-07-14 17:02) [2]

Можно.

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormPaint(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormDestroy(Sender: TObject); private ButtonsData: array [0..19] of TButton; procedure GenerateButtons; procedure ReleaseButtons; procedure ButtonClick(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} function ButtonSubclassProc(hWnd: HWND; Msg: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var OldWndProc, LeftOffset, TopOffset: Integer; WndRect, ParentRect, ParentClientRect: TRect; TmpCanvas: TCanvas; X1, Y1, X2, Y2: Integer; begin OldWndProc := GetWindowLong(hWnd, GWL_USERDATA); Result := CallWindowProc(Pointer(OldWndProc), hWnd, Msg, wParam, lParam); if Msg = WM_PAINT then begin GetWindowRect(hWnd, WndRect); GetWindowRect(GetParent(hWnd), ParentRect); GetClientRect(GetParent(hWnd), ParentClientRect); TopOffset := (ParentRect.Bottom - ParentRect.Top) - (ParentClientRect.Bottom - ParentClientRect.Top); LeftOffset := (ParentRect.Right - ParentRect.Left) - (ParentClientRect.Right - ParentClientRect.Left); X1 := ParentClientRect.Left + LeftOffset div 2 - (WndRect.Left - ParentRect.Left); Y1 := ParentClientRect.Top + TopOffset - (WndRect.Top - ParentRect.Top) - LeftOffset div 2; X2 := X1 + (ParentClientRect.Right - ParentClientRect.Left); Y2 := Y1 + (ParentClientRect.Bottom - ParentClientRect.Top); TmpCanvas := TCanvas.Create; try TmpCanvas.Handle := GetDC(hWnd); TmpCanvas.Pen.Color := clRed; TmpCanvas.Pen.Width := 4; TmpCanvas.MoveTo(X1, Y1); TmpCanvas.LineTo(X2, Y2); finally ReleaseDC(hWnd, TmpCanvas.Handle); TmpCanvas.Free; end; end; end; procedure TForm1.ButtonClick(Sender: TObject); begin ReleaseButtons; GenerateButtons; Invalidate; end; procedure TForm1.FormCreate(Sender: TObject); begin DoubleBuffered := True; GenerateButtons; end; procedure TForm1.FormDestroy(Sender: TObject); begin ReleaseButtons; end; procedure TForm1.FormPaint(Sender: TObject); begin Canvas.Pen.Color := clRed; Canvas.Pen.Width := 4; Canvas.MoveTo(0, 0); Canvas.LineTo(ClientWidth, ClientHeight); end; procedure TForm1.FormResize(Sender: TObject); begin Invalidate; end; procedure TForm1.GenerateButtons; var I: Integer; begin Randomize; for I := 0 to 19 do begin ButtonsData[I] := TButton.Create(Self); ButtonsData[I].Parent := Self; ButtonsData[I].Left := Random(ClientWidth - ButtonsData[I].Width); ButtonsData[I].Top := Random(ClientHeight - ButtonsData[I].Height); ButtonsData[I].Caption := "Button" + IntToStr(I + 1); ButtonsData[I].OnClick := ButtonClick; SetWindowLong(ButtonsData[I].Handle, GWL_USERDATA, GetWindowLong(ButtonsData[I].Handle, GWL_WNDPROC)); SetWindowLong(ButtonsData[I].Handle, GWL_WNDPROC, Integer(@ButtonSubclassProc)); end; end; procedure TForm1.ReleaseButtons; var I: Integer; begin for I := 0 to 19 do ButtonsData[I].Free; end; end.

← →
b/@. © (2009-07-14 17:12) [3]

> Rouse_ © (14.07.09 17:02) [2]

Т.е. для каждого класса контролов мне нужно релизововать подобное ?

А вот по поводу этого DoubleBuffered := True;
Можно ли рисовать напрямую этот в буффер ?

← →
Игорь Шевченко © (2009-07-14 17:14) [4]

> Есть ли простые способы рисовать на форме напрямую ?

если не секрет, нафига поверх кнопок и листбоксов рисовать ?

← →
b/@. © (2009-07-14 17:21) [5]

> Игорь Шевченко © (14.07.09 17:14) [4]
> если не секрет, нафига поверх кнопок и листбоксов рисовать ?

Хочу в определённые моменты рисовать на форме контурную ромашку, но при этом не прятать все контролы.
А так как всякого рода листбоксов, кнопок и т.п. напичкано довольно много, то от моей ромашки видно только ошмётки :(

← →
Rouse_ © (2009-07-14 17:24) [6]

> Т.е. для каждого класса контролов мне нужно релизововать подобное ?

Угу

> А вот по поводу этого DoubleBuffered := True;

Это в справке есть - грубо, это свойства убирает мерцание

← →
b/@. © (2009-07-14 17:25) [7]

> Rouse_ © (14.07.09 17:02) [2]
> Можно.

Прошу прощения. Всё получилось. Спасибо :)

PS: Хоть я пока и не понимаю как это работает...

← →
b/@. © (2009-07-14 17:27) [8]

> Rouse_ © (14.07.09 17:24) [6]
> > А вот по поводу этого DoubleBuffered := True;
> Это в справке есть - грубо, это свойства убирает мерцание

Я не об этом - в справке написано сначала контролы рисуются на битмап в памяти, вот я и подумал - что если получить доступ к этому буферу и рисовать туда после отрисовки всей формы...

> Хочу в определённые моменты рисовать на форме контурную
> ромашку, но при этом не прятать все контролы

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

> Игорь Шевченко © (14.07.09 17:31) [9]
> так сделай окно с регионом в виде контурной ромашки и рисуй его поверх формы

Думал сначала сделать снапшот окна формы, и вывести на битмап.
Но потом начал искать более "простые" способы :)
Раз при DoubleBuffered получается фактически то же самое - то дело за малым - получить доступ к этому буфферу...

> Раз при DoubleBuffered получается фактически то же самое
> - то дело за малым - получить доступ к этому буфферу...

Ты и так рисуешь сначала на нем :) Просто для тебя это не заметно :)

> то дело за малым - получить доступ к этому буфферу...

не выйдет. RTFS: Controls.pas TWinControl.WMPaint

Как рисовать на форме поверх всего ? Найти похожие ветки