How-to-avoid-flicker-using-double-buffering-in-LARGE-controls


            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.
Examples Delphi
