绘制的矩形总是在创建下一个时被擦除

Question

在下面的代码中，我希望在绘制下一个矩形时不删除先前绘制的矩形。如何实现？

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    FSelecting: Boolean;
    FSelection: TRect;
    pos1, pos2, pos3, pos4: Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FSelection.Left := X;
  FSelection.Top := Y;
  FSelecting := true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if FSelecting then
  begin
    FSelection.Right := X;
    FSelection.Bottom := Y;
    Invalidate;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FSelecting := false;
  FSelection.Right := X;
  FSelection.Bottom := Y;
  Invalidate;

  FSelection.NormalizeRect;
  if FSelection.IsEmpty then

  else
  begin
    pos1 := FSelection.Left;
    pos2 := FSelection.Top;
    pos3 := X;
    pos4 := Y;

  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clRed;
  Canvas.Rectangle(FSelection);
end;

Answer 1

当窗体的客户区无效时，整个表面都被标记为重绘。下次调用 OnPaint 时，绘制的是事件处理程序中的内容。你画了一个矩形，所以你看到了一个。

您需要积累与您需要绘制的矩形相关的信息。然后在paint handler中，大家可以参考资料，全部绘制出来。

下面的例子是问题中代码的略微修改版本。它用 TQueue 个矩形代替未使用的整数变量 (pos1, pos2..)。当鼠标按钮被释放时，一个矩形被排队并且任何多余的矩形被出列。召回矩形的最大数量由一个常量定义。绘制处理程序枚举队列以绘制矩形。

uses
  ..., generics.collections;

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FSelecting: Boolean;
    FSelection: TRect;
    FRectangles: TQueue<TRect>;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  MAXRECTANGLECOUNT = 2;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FRectangles := TQueue<TRect>.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FRectangles.Free;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FSelection.Left := X;
  FSelection.Top := Y;
  FSelecting := true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if FSelecting then
  begin
    FSelection.Right := X;
    FSelection.Bottom := Y;
    Invalidate;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FSelecting := false;
  FSelection.Right := X;
  FSelection.Bottom := Y;
  Invalidate;

  FSelection.NormalizeRect;
  if not FSelection.IsEmpty then
  begin
    FRectangles.Enqueue(FSelection);
    if FRectangles.Count > MAXRECTANGLECOUNT then
      FRectangles.Dequeue;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  R: TRect;
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clRed;
  Canvas.Rectangle(FSelection);

  for R in FRectangles do
    Canvas.Rectangle(R);
end;

end.

绘制的矩形总是在创建下一个时被擦除

Rectangle drawn always is erased when the next is created

delphi

canvas

draw

delphi-10.3-rio