Question

I thought I could just throw this out there and just ask: I have seen Delphi controls that are flawless in terms of graphical effects. Meaning: no flickering, sectioned updates (only redraw the section of a control that is marked as dirty) and smooth scrolling.

I have coded a lot of graphical controls over the years, so I know about double buffering, dibs, bitblts and all the “common” stuff (I always use dibs to draw everything if possible, but there is an overhead). Also know about InvalidateRect and checking TCanvas.ClipRect for the actual rect that needs to be updated. Despite all these typical solutions, I find it very difficult to create the same quality components as say – Developer Express or Razed Components. If the graphics is smooth you can bet the scrollbars (native) flicker, and if the scrollbars and frame is smooth you can swear the background flickers during scrolling.

Is there a standard setup of code to handle this? A sort of best practises that ensures smooth redraws of the entire control — including the non-client area of a control?

For instance, here is a “bare bone” control which take height for segmented updates (only redraw what is needed). If you create it on a form, try moving a window over it, and watch it replace the parts with colors (see paint method).

Does anyone have a similar base class that can handle non client area redraws without flickering?

type

TMyControl = Class(TCustomControl)
private
  (* TWinControl: Erase background prior to client-area paint *)
  procedure WMEraseBkgnd(var Message: TWmEraseBkgnd);message WM_ERASEBKGND;
Protected
  (* TCustomControl: Overrides client-area paint mechanism *)
  Procedure Paint;Override;

  (* TWinControl: Adjust Win32 parameters for CreateWindow *)
  procedure CreateParams(var Params: TCreateParams);override;
public
  Constructor Create(AOwner:TComponent);override;
End;


{ TMyControl }

Constructor TMyControl.Create(AOwner:TComponent);
Begin
  inherited Create(Aowner);
  ControlStyle:=ControlStyle - [csOpaque];
end;

procedure TMyControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  (* When a window has this style set, any areas that its
     child windows occupy are excluded from the update region. *)
  params.ExStyle:=params.ExStyle + WS_CLIPCHILDREN;

  (* Exclude VREDRAW & HREDRAW *)
  with Params.WindowClass do
  Begin
    (* When a window class has either of these two styles set,
       the window contents will be completely redrawn every time it is
       resized either vertically or horizontally (or both) *)
    style:=style - CS_VREDRAW;
    style:=style - CS_HREDRAW;
  end;
end;

procedure TMyControl.Paint;

  (* Inline proc: check if a rectangle is "empty" *)
  function isEmptyRect(const aRect:TRect):Boolean;
  Begin
    result:=(arect.Right=aRect.Left) and (aRect.Bottom=aRect.Top);
  end;

  (* Inline proc: Compare two rectangles *)
  function isSameRect(const aFirstRect:TRect;const aSecondRect:TRect):Boolean;
  Begin
    result:=sysutils.CompareMem(@aFirstRect,@aSecondRect,SizeOf(TRect))
  end;

  (* Inline proc: This fills the background completely *)
  Procedure FullRepaint;
  var
    mRect:TRect;
  Begin
    mRect:=getClientRect;
    AdjustClientRect(mRect);
    Canvas.Brush.Color:=clWhite;
    Canvas.Brush.Style:=bsSolid;
    Canvas.FillRect(mRect);
  end;

begin
  (* A full redraw is only issed if:
      1. the cliprect is empty
      2. the cliprect = clientrect *)
  if isEmptyRect(Canvas.ClipRect)
  or isSameRect(Canvas.ClipRect,Clientrect) then
  FullRepaint else
  Begin
    (* Randomize a color *)
    Randomize;
    Canvas.Brush.Color:=RGB(random(255),random(255),random(255));

    (* fill "dirty rectangle" *)
    Canvas.Brush.Style:=bsSolid;
    Canvas.FillRect(canvas.ClipRect);
  end;
end;

procedure TMyControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  message.Result:=-1;
end;

Updated

I just wanted to add that what did the trick was a combination of:

1. ExcludeClipRect() when drawing the non-clientarea, so you dont overlap with the graphics in the clientarea

2. Catching the WMNCCalcSize message rather than just using the bordersize for measurements. I also had to take height for the edge sizes:

   XEdge := GetSystemMetrics(SM_CXEDGE);
   YEdge := GetSystemMetrics(SM_CYEDGE);
   

3. Calling RedrawWindow() with the following flags whenever you have scrollbars that have moved or a resize:

   mRect:=ClientRect;
   mFlags:=rdw_Invalidate
     or RDW_NOERASE
     or RDW_FRAME
     or RDW_INTERNALPAINT
     or RDW_NOCHILDREN;
   RedrawWindow(windowhandle,@mRect,0,mFlags);
   

4. When updating the background during the Paint() method, avoid drawing over possible child objects, like this (see the RDW_NOCHILDREN mentioned above):

   for x := 1 to ControlCount do
   begin
     mCtrl:=Controls[x-1];
     if mCtrl.Visible then
     Begin
       mRect:=mCtrl.BoundsRect;
       ExcludeClipRect(Canvas.Handle,
       mRect.Left,mRect.Top,
       mRect.Right,mRect.Bottom);
     end;
   end;
   

Thanks for the help guys!

Answer 1

For instance, here is a "bare bone" control which take height for segmented updates (only redraw what is needed). If you create it on a form, try moving a window over it, and watch it replace the parts with colors (see paint method).

Does anyone have a similar base class that can handle non client area redraws without flickering?

Well, your TMyControl does not have a non client area (yet). So I added BorderWidth := 10; and now it has. 😉

In general, the non client area’s of default Windows windows are automatically painted without flickering, including scrollbars, titles, etc… (at least, I have not witnessed otherwise).

If you want to paint your own border, you have to handle WM_NCPAINT. See this code:

unit Unit2;

interface

uses
  Classes, Controls, Messages, Windows, SysUtils, Graphics;

type
  TMyControl = class(TCustomControl)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  protected
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner:TComponent);override;
  end;

implementation

{ TMyControl }

constructor TMyControl.Create(AOwner:TComponent);
Begin
  Randomize;
  inherited Create(Aowner);
  ControlStyle:=ControlStyle - [csOpaque];
  BorderWidth := 10;
  Anchors := [akLeft, akTop, akBottom, akRight];
end;

procedure TMyControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle or WS_CLIPCHILDREN;
  with Params.WindowClass do
    style := style and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TMyControl.Paint;
begin
  Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255));
  Canvas.FillRect(Canvas.ClipRect);
end;

procedure TMyControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TMyControl.WMNCPaint(var Message: TWMNCPaint);
var
  DC: HDC;
  R: TRect;
begin
  Message.Result := 0;
  if BorderWidth > 0 then
  begin
    DC := GetWindowDC(Handle);
    try
      R := ClientRect;
      OffsetRect(R, BorderWidth, BorderWidth);
      ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
      SetRect(R, 0, 0, Width, Height);
      Brush.Color := clYellow;
      FillRect(DC, R, Brush.Handle);
    finally
      ReleaseDC(Handle, DC);
    end;
  end;
end;

end.

A few remarks:

• Override CreateParams instead of declaring it virtual. Mind the compiler warning (though I think/hope this is a little mistake).
• You don’t have to check for isEmptyRect nor isSameRect. If ClipRect is empty, then there is nothing to draw. This is also the reason why never to call Paint directly, but always through Invalidate or equivalent.
• AdjustClientRect is not needed. It is called internally when needed for its purpose.

And as a bonus, this is exactly how I draw a chessbord component:

type
  TCustomChessBoard = class(TCustomControl)
  private
    FBorder: TChessBoardBorder;
    FOrientation: TBoardOrientation;
    FSquareSize: TSquareSize;
    procedure BorderChanged;
    procedure RepaintBorder;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    function GetClientRect: TRect; override;
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Repaint; override;
  end;

const
  ColCount = 8;
  RowCount = ColCount;

procedure TCustomChessBoard.BorderChanged;
begin
  RepaintBorder;
end;

constructor TCustomChessBoard.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csOpaque];
end;

procedure TCustomChessBoard.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params.WindowClass do
    style := style and not (CS_HREDRAW or CS_VREDRAW);
end;

function TCustomChessBoard.GetClientRect: TRect;
begin
  Result := Rect(0, 0, FSquareSize * ColCount, FSquareSize * RowCount);
end;

procedure TCustomChessBoard.Paint;

  procedure DrawSquare(Col, Row: Integer);
  var
    R: TRect;
  begin
    R := Bounds(Col * FSquareSize, Row * FSquareSize, FSquareSize, FSquareSize);
    Canvas.Brush.Color := Random(clWhite);
    Canvas.FillRect(R);
  end;

var
  iCol: Integer;
  iRow: Integer;
begin
  with Canvas.ClipRect do
    for iCol := (Left div FSquareSize) to (Right div FSquareSize) do
      for iRow := (Top div FSquareSize) to (Bottom div FSquareSize) do
        DrawSquare(iCol, iRow);
end;

procedure TCustomChessBoard.Repaint;
begin
  inherited Repaint;
  RepaintBorder;
end;

procedure TCustomChessBoard.RepaintBorder;
begin
  if Visible and HandleAllocated then
    Perform(WM_NCPAINT, 0, 0);
end;

procedure TCustomChessBoard.Resize;
begin
  Repaint;
  inherited Resize;
end;

procedure TCustomChessBoard.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TCustomChessBoard.WMNCPaint(var Message: TWMNCPaint);
var
  DC: HDC;
  R: TRect;
  R2: TRect;
  SaveFont: HFONT;

  procedure DoCoords(ShiftX, ShiftY: Integer; Alpha, Backwards: Boolean);
  const
    Format = DT_CENTER or DT_NOCLIP or DT_SINGLELINE or DT_VCENTER;
    CoordChars: array[Boolean, Boolean] of Char = (('1', '8'), ('A', 'H'));
  var
    i: Integer;
    C: Char;
  begin
    C := CoordChars[Alpha, Backwards];
    for i := 0 to ColCount - 1 do
    begin
      DrawText(DC, PChar(String(C)), 1, R, Format);
      DrawText(DC, PChar(String(C)), 1, R2, Format);
      if Backwards then
        Dec(C)
      else
        Inc(C);
      OffsetRect(R, ShiftX, ShiftY);
      OffsetRect(R2, ShiftX, ShiftY);
    end;
  end;

  procedure DoBackground(Thickness: Integer; AColor: TColor;
    DoPicture: Boolean);
  begin
    ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
    InflateRect(R, Thickness, Thickness);
    if DoPicture then
      with FBorder.Picture.Bitmap do
        BitBlt(DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
          Canvas.Handle, R.Left, R.Top, SRCCOPY)
    else
    begin
      Brush.Color := AColor;
      FillRect(DC, R, Brush.Handle);
    end;
  end;

begin
  Message.Result := 0;
  if BorderWidth > 0 then
    with FBorder do
    begin
      DC := GetWindowDC(Handle);
      try
        { BackGround }
        R := Rect(0, 0, Self.Width, Height);
        InflateRect(R, -Width, -Width);
        DoBackground(InnerWidth, InnerColor, False);
        DoBackground(MiddleWidth, MiddleColor, True);
        DoBackground(OuterWidth, OuterColor, False);
        { Coords }
        if CanShowCoords then
        begin
          ExtSelectClipRgn(DC, 0, RGN_COPY);
          SetBkMode(DC, TRANSPARENT);
          SetTextColor(DC, ColorToRGB(Font.Color));
          SaveFont := SelectObject(DC, Font.Handle);
          try
            { Left and right side }
            R := Bounds(OuterWidth, Width, MiddleWidth, FSquareSize);
            R2 := Bounds(Self.Width - OuterWidth - MiddleWidth, Width,
              MiddleWidth, FSquareSize);
            DoCoords(0, FSquareSize, FOrientation in [boRotate090, boRotate270],
              FOrientation in [boNormal, boRotate090]);
            { Top and bottom side }
            R := Bounds(Width, OuterWidth, FSquareSize, MiddleWidth);
            R2 := Bounds(Width, Height - OuterWidth - MiddleWidth, FSquareSize,
              MiddleWidth);
            DoCoords(FSquareSize, 0,  FOrientation in [boNormal, boRotate180],
              FOrientation in [boRotate090, boRotate180]);
          finally
            SelectObject(DC, SaveFont);
          end;
        end;
      finally
        ReleaseDC(Handle, DC);
      end;
    end;
end;