Le rectangle dessiné est toujours effacé lorsque le suivant est créé

Question

Dans le code ci-dessous, je voudrais que le rectangle précédemment dessiné ne soit pas effacé lorsque le rectangle suivant est dessiné. Comment y parvenir ?

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

Lorsque la zone client du formulaire est invalidée, toute la surface est marquée pour être redessinée. La prochaine fois que OnPaint est appelé, ce qui est peint est ce qui se trouve dans le gestionnaire d'événements. Vous dessinez un rectangle et vous en voyez un.

Vous devez accumuler les informations relatives aux rectangles que vous devez dessiner. Ensuite, dans le gestionnaire de peinture, vous pouvez vous référer à ces informations et les dessiner tous.

L'exemple ci-dessous est la version légèrement modifiée du code de la question. Il substitue un TQueue de rectangles à la place des variables entières inutilisées (pos1, pos2..). Un rectangle est mis en file d'attente et tout rectangle excédentaire est mis hors file d'attente lorsque le bouton de la souris est relâché. Le nombre maximum de rectangles rappelés est défini par une constante. Le gestionnaire de peinture énumère la file d'attente pour dessiner les rectangles.

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.