3

问题是：我在桌面上绘制了一些矩形，而鼠标移动（矩形大小增加）我没有滞后、伪影等，一切都很好： 在此处输入图像描述

但是，当我将矩形的大小调整为低于原来的尺寸时，我得到了人工制品： 在此处输入图像描述

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

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

移动后鼠标绝对停止时是否有解决方案？

更新

编码：

    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.
4

2 回答 2

7

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

然后，在OnMouseMove事件处理程序中，实际上是OnMouseDownand OnMouseUp，调用Invalidate窗体或 Win32InvalidateRect函数，以强制绘制循环。

于 2014-07-24T13:19:43.283 回答
1

Paint into a layered window instead. That will give you great speed without the artefacts, and Windows takes care of the drawing.

A layered window is a window that is created by specifying WS_EX_LAYERED when creating the window with the CreateWindowEx function. Later you can use UpdateLayeredWindow in order to set the content of this window. That way you can paint on top of a canvas without modifying the content of the canvas.

Of course this is a more advanced approach to solving your problem. So you need to have some knowledge about the Windows API.

于 2014-07-24T11:24:56.950 回答