2010. augusztus 24., kedd

How to repaint a TPaintBox without erasing the background


Problem/Question/Abstract:

How can I repaint a TPaintBox object without erasing the background. I have to repaint a bitmap object and some lines every second. Just invalidating and/ or calling the repaint method of the TPaintBox results in a redraw, that's right; but I get a flicker everytime, because the background will be erased (e.g. the old bitmap) and afterwards the new one will be drawn.

Answer:

There are two techniques that spring to mind. Try the following:

procedure TForm1.FormCreate(Sender: TObject);
begin
  PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
end;

It will prevent the area of the form behind the paint box from being redrawn when the paint box is invalidated.

If this is not enough, you can use a "cracker" class to force the paint routine without an invalidate. Using a double buffer will prevent flicker. Here's an example:

TForm1 = class(TForm)
  Button1: TButton;
  Button2: TButton;
  PaintBox1: TPaintBox;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
  procedure PaintBox1Paint(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
private
  FDoubleBuffer: TBitmap;
end;

type
  TPaintBoxCracker = class(TPaintBox);

procedure TForm1.Button1Click(Sender: TObject);
begin
  with FDoubleBuffer.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(Rect(0, 0, FDoubleBuffer.Width, FDoubleBuffer.Height));
    Pen.Color := clBlue;
    MoveTo(FDoubleBuffer.Width, FDoubleBuffer.Height);
    LineTo(0, 0);
  end;
  TPaintBoxCracker(PaintBox1).Paint;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with FDoubleBuffer.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(Rect(0, 0, FDoubleBuffer.Width, FDoubleBuffer.Height));
    Pen.Color := clRed;
    MoveTo(0, 0);
    LineTo(FDoubleBuffer.Width, FDoubleBuffer.Height);
  end;
  TPaintBoxCracker(PaintBox1).Paint;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, FDoubleBuffer);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
  FDoubleBuffer := TBitmap.Create;
  FDoubleBuffer.Width := PaintBox1.Width;
  FDoubleBuffer.Height := PaintBox1.Height;
end;

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

Nincsenek megjegyzések:

Megjegyzés küldése