How to do flicker-free painting on the canvas of a TDBGrid

Problem/Question/Abstract:

Does anyone have the code for a flicker-free TDBGrid without the vertical scrollbar. Or could anyone explain how I get rid of the flicker? I thought it might be a good idea to set the DefaultDrawing property to False and handle all the drawing in the OnDrawDataCell event using an offscreen bitmap.

Answer:

Solve 1:

It would be better to allow DBGrid to still do the drawing, rather than manually replicating the code via OnDrawDataCell, but instead retro-fitting off-screen bitmap drawing into the control. This technique involves hooking the WM_Paint message, and forcing the control to paint into an off-screen bitmap, then finally BitBlt'ing the bitmap back to the screen. The code can be retro-fitted to any existing control via a simple subclass, or for those inclined by run-time subclassing of the control's WndProc. Note that if the control has sub-controls (with their own canvases), then only the control's canvas itself will be painted flicker-free.

type
  TFlickerFreeDBGrid = class(TDBGrid)
  private
    procedure WMPaint(var Message: TWMPaint); message WM_Paint;
  end;

procedure TFlickerFreeDBGrid.WMPaint(var Message: TWMPaint);
var
  WinDC, MemDC: HDC;
  Bitmap, OldBitmap: HBITMAP;
  PS: TPaintStruct;
  BegunPaint: Boolean;
begin
  BegunPaint := False;
  {Allocate a window DC, if needed}
  WinDC := Message.DC;
  if WinDC = 0 then
  begin
    WinDC := BeginPaint(Handle, PS);
    BegunPaint := True;
  end;
  {Allocate a memory DC}
  MemDC := CreateCompatibleDC(Canvas.Handle);
  Bitmap := CreateCompatibleBitmap(Canvas.Handle, Width, Height);
  OldBitmap := SelectObject(MemDC, Bitmap);
  try
    {Normal drawing, but into MemDC}
    Message.DC := MemDC;
    inherited;
    {Copy MemDC to WinDC}
    with Canvas.ClipRect do
      BitBlt(WinDC, Left, Top, Right - Left, Bottom - Top, MemDC, Left, Top, SRCCOPY);
  finally
    {Deallocate memory DC}
    SelectObject(MemDC, OldBitmap);
    DeleteObject(Bitmap);
    DeleteDC(MemDC);
    if BegunPaint then
      EndPaint(Handle, PS);
  end;
end;


Solve 2:

Another (possibly cleaner way than Answer 1) to approach this within the Delphi class framework is to override the PaintWindow method, something like this:

procedure TBufferedDBGrid.PaintWindow(DC: HDC);
var
  Bitmap: TBitmap;
begin
  if (DC <> 0) then
  begin
    {Buffered drawing occurs on an off-screen bitmap}
    Bitmap := TBitmap.Create;
    try
      {Set bitmap attributes}
      Bitmap.Width := Width;
      Bitmap.Height := Height;
      {Set the canvas handle to the bitmap}
      Canvas.Handle := Bitmap.Canvas.Handle;
      try
        Paint;
        Canvas.Handle := DC;
        Canvas.CopyRect(ClipRect, Bitmap.Canvas, ClipRect);
      finally
        Canvas.Handle := 0;
      end;
    finally
      Bitmap.Free;
    end;
  end;
end;

A performance optimization would be to create / destroy the offscreen bitmap in the constructor / destructor, and (re)size the bitmap in an overridden SetBounds method - though keeping the bitmap around at all times will hog memory. Where the best trade off is depends on the design considerations of the application.


Solve 3:

The above code (Answer 2) is indeed a lot cleaner, and I much prefer clean high-level VCL code to my code which is low-level using the Win-API. However, there is a major difference between your cleaner code and mine. My code was written to handle flicker-free drawing of a panel that owns large TGraphicControl children (eg TLabel, TShape, which use the panel's canvas for drawing, hence major flicker). My code will paint both the panel AND its TGraphicControl children in the off-screen bitmap.

Your code, on the other hand, would only paint the panel in the bitmap, leaving the children to be drawn direct to screen as normal (in PaintHandler). This is because you intercept the PaintWindow method which is only responsible for the control's painting. not including any TGraphicControl children. I intercept the WM_Paint message directly, letting the VCL (and any future versions of it) paint the control in a completely normal fashion, but in to the bitmap.

So I've written a hybrid, taking the cleaner VCL approach you have (ie let TBitmap handle the CreateCompatibleDC etc), with my technique for also painting the children without flicker.

Note the same optimisations apply here. I actually only create a single bitmap for the whole application, resizing it larger and larger as needed. True, it can take up a lot of memory on high-colour screens, but anyone running high-colour will have more memory anyway. And there's only a single off-screen bitmap shared around all controls that need it, so I can can use the flicker-free technique wherever its useful.

procedure WMPaint(var Message: TWMPaint);
var
  Bitmap: TBitmap;
  WinDC: HDC;
  PS: TPaintStruct;
  BegunPaint: Boolean;
begin
  BegunPaint := False;
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := Width;
    Bitmap.Height := Height;
    {Paint completely as normal, but into Bitmap}
    WinDC := Message.DC;
    Message.DC := Bitmap.Canvas.Handle;
    inherited;
    {Need a Window DC ?}
    BegunPaint := WinDC = 0;
    if BegunPaint then
      WinDC := BeginPaint(Handle, PS);
    {Copy bitmap to screen}
    with Canvas.ClipRect do
      BitBlt(WinDC, Left, Top, Right - Left, Bottom - Top, Bitmap.Canvas.Handle, Left,
        Top, SRCCOPY);
  finally
    Bitmap.Free;
    if BegunPaint then
      EndPaint(Handle, PS);
  end;
end;