Search code examples
delphicanvasdrawdelphi-10.3-rio

Rectangle drawn always is erased when the next is created


In the code below I would like the previously drawn rectangle to not be erased when the next rectangle is drawn. How achieve this?

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;

Solution

  • When the form's client area is invalidated the entire surface is marked for redrawing. The next time OnPaint is called, what is painted is what is in the event handler. You draw one rectangle and so you see one.

    You need to accumulate the information related to the rectangles you need to draw. Then in the paint handler, you can refer to the information and draw them all.

    Below example is the slightly modified version of the code in the question. It substitutes a TQueue of rectangles in the place of unused integer variables (pos1, pos2..). A rectangle is queued and any excess rectangle is dequeued when mouse the button is released. Maximum number of recalled rectangles is defined by a constant. The paint handler enumerates the queue to draw the 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.