Question

问题是：我在桌面上绘制一些矩形，同时鼠标移动（矩形大小增加）我没有滞后，人工制品等等，一切都很好： enter image description here

但是当我将矩形调整到低于它的尺寸时，我有了人工制品： enter image description here

红色矩形是真正的矩形，其他都是错误。

完美的解决方案是重绘画布，但在鼠标移动时我不能一直这样做。

移动后鼠标绝对停止会有解决办法吗？

更新

代码：

    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是的，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.

Answer 1

你的问题是你在错误的地方画画。停止在OnMouseMove事件处理程序中绘画。将绘制代码移动到绘制处理程序。例如表单的OnPaint处理程序。

然后，在OnMouseMove事件处理程序中，确实是OnMouseDown和OnMouseUp，请在表单或Win32 Invalidate函数上调用InvalidateRect强迫油漆循环。

Answer 2

改为绘制到分层窗口。这样可以在没有人工制品的情况下提供极快的速度，Windows可以处理绘图。

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

当然，这是解决问题的更先进方法。所以你需要掌握一些关于Windows API的知识。

如何及时重新绘制画布？

2 个答案: