以Delphi形式绘制控件

procedure TForm1.FormPaint(Sender: TObject);
var x,y: Integer;
begin
  x := Mouse.CursorPos.X - 10;
  y := Mouse.CursorPos.Y - 10;
  x := ScreentoClient(point(x,y)).X - 10;
  y := ScreenToClient(point(x,y)).Y - 10;
  Canvas.Brush.Color := clRed;
  Canvas.FillRect(rect(x,y,x + 10,y + 10));
  Invalidate;
end;

不要在绘图处理程序中“无效”. Invalidating导致发送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,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,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,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),0);

    ReleaseDC(Handle,DC);
  end;
end;