不要在油漆处理程序中“无效”。 Invalidating 会导致发送WM_PAINT，这当然会开始整个油漆处理。即使您不移动鼠标，您发布的代码示例也会导致“OnPaint”事件一次又一次地运行。由于您的绘图取决于光标的位置，因此您将为此使用“OnMouseMove”事件。但是您还需要拦截其他窗口控件的鼠标消息。出于这个原因，下面的示例使用了“ApplicationEvents”组件。如果您的应用程序将有多个表单，您需要设计一种机制来区分您在哪个表单上绘图。
另请参阅文档，VCL 的 Invalidate 使整个窗口无效。您不需要这样做，您正在绘制一个小矩形，并且您确切知道要在哪里绘制。只是使您将绘制的位置和绘制的位置无效。
至于在控件上绘图，实际上绘图部分很容易，但是您不能使用提供的画布来做到这一点。窗体具有WS_CLIPCHILDREN 样式，子窗口的表面将被排除在更新区域之外，因此您必须使用GetDCEx 或GetWindowDC。正如 cmets 中提到的“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;