如何实时重新绘制画布？

Question

问题是： 我在桌面上绘制了一些矩形，在鼠标移动时（矩形大小增加），我没有遇到卡顿、伪像等问题，一切都很好。 但是当我将矩形的大小调整为比之前小时，我就会看到伪像出现： 红色矩形是真正的矩形，其他都是错误的。

最完美的解决方法是重新绘制画布，但是在鼠标移动时一直这样做是不可行的。

有没有办法在鼠标移动后绝对停止时执行某些操作？

更新内容:

代码:

    unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    isDown: Boolean;
    downX, downY: Integer;
  public
    { Public declarations }
    Bild: TBitMap;
  end;

implementation

{ 表单属性： BorderStyle= bsNone AlphaBlend为true，透明度为150 TransparentColor为true，颜色为clBlack }

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  Bild := TBitMap.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  Bild.Free;
end;

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  isDown := true;
  downX := X;
  downY := Y;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
const
  cVal = 4;
begin
  if isDown then
  begin
    Self.Canvas.Lock;
    Self.Repaint;
    Self.Canvas.Pen.Color := clNone;
    Self.Canvas.Pen.Width := 1;

    Self.Canvas.Pen.Style := psDot;
    //Self.Canvas.Pen.Mode := pmNotCopy;
    Self.Canvas.Brush.Color := clGreen;
    Self.Canvas.Rectangle(downX, downY, X, Y);
    Self.Canvas.Pen.Style := psSolid;
    Self.Canvas.Brush.Color := clNone;
    Self.Canvas.Unlock;
    { Self.Canvas.Rectangle(downX - cVal, downY - cVal, downX + cVal, downY + cVal);
     Self.Canvas.Rectangle(X - cVal, Y - cVal, X + cVal, Y + cVal);
     Self.Canvas.Rectangle(X - cVal, downY - cVal, X + cVal, downY + cVal);
     Self.Canvas.Rectangle(downX - cVal, Y - cVal, downX + cVal, Y + cVal);

     Self.Canvas.Rectangle(downX - cVal, (downY + Y) div 2 - cVal, downX + cVal,
       (downY + Y) div 2 + cVal);
     Self.Canvas.Rectangle(X - cVal, (downY + Y) div 2 - cVal, X + cVal,
       (downY + Y) div 2 + cVal);

     Self.Canvas.Rectangle((downX + X) div 2 - cVal, downY - cVal,
       (downX + X) div 2 + cVal, downY + cVal);
     Self.Canvas.Rectangle((downX + X) div 2 - cVal, Y - cVal, (downX + X) div 2 + cVal,
       Y + cVal);   }
  end;
end;

function CaptureRect(aRect: TRect; out aBmp: TBitmap): Boolean;
var
  ScreenDC: HDC;
begin
  Result := False;
  try
    with aBmp, aRect do
    begin
      Width := Right - Left;
      Height := Bottom - Top;
      ScreenDC := GetDC(0);
      try
        BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
      finally
        ReleaseDC(0, ScreenDC);
      end;
    end;
  except
  end;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  r: TRect;
begin
  isDown := false;
  r.Left := downX;
  r.Top := downY;
  r.Right := X;
  r.Bottom := Y;
  CaptureRect(r, Bild);
  Self.Close;
end;

end.

- AlexLL

---

您可以使用 pmXor 模式的笔来超出 旧矩形。 - TLama

不好意思，这个没成功。 - AlexLL

你有任何代码吗？你怎么能在你不拥有的窗口上绘图呢？如果其他应用程序开始在你的窗口上绘图，你会喜欢吗？如果你的程序停止工作，你会感到惊讶吗？你会尝试通过更改代码来适应这个问题，还是会责备其他程序？你明白绘画如何工作吗？具体来说，窗口需要能够在任何时候响应WM_PAINT消息更新自己，并且不需要具有持久状态。 - David Heffernan

Answer 1

您的问题是您在错误的位置绘画。停止在OnMouseMove事件处理程序中绘图，将绘图代码移到绘画处理程序中。例如，移至窗体的OnPaint处理程序。

然后，在OnMouseMove事件处理程序中，以及OnMouseDown和OnMouseUp中，调用Invalidate函数或Win32InvalidateRect函数来强制执行绘画周期。

- David Heffernan

---

非常感谢！问题已经解决了。 - AlexLL

Answer 2

在分层窗口中进行绘制，这将使您获得更快的速度且没有伪像，并且Windows会处理绘图。

分层窗口是通过在使用CreateWindowEx函数创建窗口时指定WS_EX_LAYERED来创建的窗口。稍后，您可以使用UpdateLayeredWindow来设置此窗口的内容。这样，您就可以在画布顶部绘制而不修改画布的内容。

当然，这是解决问题的一种更高级的方法。因此，您需要了解Windows API的一些知识。

- Sebastian Z

---

你能否更简单地描述一下你所说的“在分层窗口中绘制”是什么意思？我的英语词典不够完美，无法真正理解它的含义。 - AlexLL

我使用bsNone的窗口，宽度和高度与屏幕大小相等。 - AlexLL

@AlexLL 如果你不展示任何代码，我们只能猜测你在做什么。这样一点也不有效率。如果你想要帮助，你需要更加努力地让我们所有人清楚地知道你在做什么。在你这样做之前，这将是一个相当无果且痛苦的过程。 - David Heffernan

@Srbastian_Z，请回答。 - AlexLL

我更新了我的回答。但是现在你展示了你的代码，可能有一种更简单的方法来实现所需的结果。 - Sebastian Z

我认为DavidH提供的解决方案更好，但你的解决方案也很有趣（另一种解决方案）。 - Gabriel