Не «аннулировать» в обработчике краски. При аннулировании происходит отправка WM_PAINT
, что, конечно, запускает обработку краски. Даже если вы не двигаете мышь, пример кода, который вы разместили, будет вызывать событие «OnPaint» снова и снова. Так как ваш рисунок зависит от положения курсора, вы бы использовали для этого событие «OnMouseMove». Но вам нужно перехватывать сообщения мыши и для других оконных элементов управления. Приведенный ниже пример использует компонент ApplicationEvents по этой причине. Если ваше приложение будет иметь более одной формы, вам необходимо разработать механизм для определения формы, на которой вы рисуете.
Также смотрите на документах, что VCL Invalidate
делает недействительным все окно. Вам не нужно этого делать, вы рисуете крошечный прямоугольник и точно знаете, где рисуете. Просто лишите законной силы, где вы будете рисовать и где вы рисовали.
Что касается рисования на элементах управления, на самом деле рисовать часть легко, но вы не можете сделать это с предоставленным холстом. Формы имеют стиль WS_CLIPCHILDREN
, поверхности дочерних окон будут исключены из области обновления, поэтому вам придется использовать GetDCEx
или GetWindowDC
. Как упоминалось в комментариях «user205376», удаление того, что вы нарисовали, немного сложнее, поскольку вы можете нарисовать один прямоугольник на нескольких элементах управления. Но у API есть и ярлык для этого, как вы увидите в коде.
Я попытался немного прокомментировать код, чтобы иметь возможность следовать, но пропустил обработку ошибок. Фактическое рисование может быть в обработчике события OnPaint, но элементы управления, которые не происходят от TWinControl, рисуются после обработчика. Так что это в обработчике WM_PAINT.
type
TForm1 = class(TForm)
[..]
ApplicationEvents1: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
private
FMousePt, FOldPt: TPoint;
procedure WM_PAINT(var Msg: TWmPaint); message WM_PAINT;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
// no rectangle drawn at form creation
FOldPt := Point(-1, -1);
end;
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var
R: TRect;
Pt: TPoint;
begin
if Msg.message = WM_MOUSEMOVE then begin
// assume no drawing (will test later against the point).
// also, below RedrawWindow will cause an immediate WM_PAINT, this will
// provide a hint to the paint handler to not to draw anything yet.
FMousePt := Point(-1, -1);
// first, if there's already a previous rectangle, invalidate it to clear
if (FOldPt.X > 0) and (FOldPt.Y > 0) then begin
R := Rect(FOldPt.X - 10, FOldPt.Y - 10, FOldPt.X, FOldPt.Y);
InvalidateRect(Handle, @R, True);
// invalidate childs
// the pointer could be on one window yet parts of the rectangle could be
// on a child or/and a parent, better let Windows handle it all
RedrawWindow(Handle, @R, 0,
RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
end;
// is the message window our form?
if Msg.hwnd = Handle then
// then save the bottom-right coordinates
FMousePt := SmallPointToPoint(TSmallPoint(Msg.lParam))
else begin
// is the message window one of our child windows?
if GetAncestor(Msg.hwnd, GA_ROOT) = Handle then begin
// then convert to form's client coordinates
Pt := SmallPointToPoint(TSmallPoint(Msg.lParam));
windows.ClientToScreen(Msg.hwnd, Pt);
FMousePt := ScreenToClient(Pt);
end;
end;
// will we draw? (test against the point)
if PtInRect(ClientRect, FMousePt) then begin
R := Rect(FMousePt.X - 10, FMousePt.Y - 10, FMousePt.X, FMousePt.Y);
InvalidateRect(Handle, @R, False);
end;
end;
end;
procedure TForm1.WM_PAINT(var Msg: TWmPaint);
var
DC: HDC;
Rgn: HRGN;
begin
inherited;
if (FMousePt.X > 0) and (FMousePt.Y > 0) then begin
// save where we draw, we'll need to erase before we draw an other one
FOldPt := FMousePt;
// get a dc that could draw on child windows
DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);
// don't draw on borders & caption
Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top,
ClientRect.Right, ClientRect.Bottom);
SelectClipRgn(DC, Rgn);
DeleteObject(Rgn);
// draw a red rectangle
SelectObject(DC, GetStockObject(DC_BRUSH));
SetDCBrushColor(DC, ColorToRGB(clRed));
FillRect(DC, Rect(FMousePt.X - 10, FMousePt.Y - 10, FMousePt.X, FMousePt.Y), 0);
ReleaseDC(Handle, DC);
end;
end;