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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése