Mega Code Archive
How to avoid flicker using double buffering in LARGE controls
<![CDATA[
Title: How to avoid flicker using double buffering in LARGE controls?
Question: You may avoid flicker by setting DoubleBuffered property of TWinControl to True - this will cause control first to paint itself to memory bitmap and then copy this bitmap into its device context. Unfortunatelly, this trick does not work on large controls cause buffering bitmap will take too much memory - even if this TWinControl will be kept inside a smaller one - for example, TPanel sized 10000x10000 inside of TScrollBox sized 100x100.
Answer:
The problem is in WM_PAINT message handler of the TWinControl:
procedure TWinControl.WMPaint(var Message: TWMPaint);
...
begin
...
MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
...
end;
As you may see, this method creates a memory bitmap which size is just the same as the size of the control itself - in our case 10000x10000, that's too much. Solution may be creating a smaller buffer.
Let's create a component TMyPanel inherited form TPanel and override WM_PAINT handler as follows:
procedure TMyPanel.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
begin
if not FDoubleBuffered or (Message.DC 0) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = 0) then
inherited
else
PaintHandler(Message);
end
else
begin
DC := GetDC(0);
// Creating smaller buffer
MemBitmap := CreateCompatibleBitmap(DC, FBufferWidth, FBufferHeight);
ReleaseDC(0, DC);
MemDC := CreateCompatibleDC(0);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := BeginPaint(Handle, PS);
Perform(WM_ERASEBKGND, MemDC, MemDC);
Message.DC := MemDC;
// Move vieport origin
MoveViewportOrg(Message.DC, Left, Top);
// Draw in the buffer
WMPaint(Message);
// Move viewport origin back
MoveViewportOrg(Message.DC, -Left, -Top);
Message.DC := 0;
// Copy buffer with the offset
BitBlt(DC, -Left, -Top, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
EndPaint(Handle, PS);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
end;
MoveViewportOrg procedure is quite similar to MoveWindowOrg:
procedure MoveViewportOrg(DC: HDC; DX, DY: integer);
var
P: TPoint;
begin
GetViewportOrgEx(DC, P);
SetViewportOrgEx(DC, P.X + DX, P.Y + DY, nil);
end;
FBufferWidth and FBufferHeight indicate buffer's width and height. In our case, FBufferWidth:=100 and FBufferHeight:=100 are quite enough for TScrollBox sized 100x100.
P.S. This article is kinda request for comments. I am not sure that this trick will work in 100% of cases, but do not see any faults. Please feel free to comment.
]]>