How to make my TCustomControl descendant component stop flickering?

Question

I have a graphical TCustomControl descendant component with a TScrollBar on it. The problem is that when I press the arrow key to move the cursor the whole canvas is painted in background color, including the region of the scroll bar, then the scroll bar is repainted and that makes scroll bar flicker. How can I solve this ?

Here is the code. There is no need install the component or to put something on the main form, just copy the code and assign TForm1.FormCreate event:

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SuperList;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  List: TSuperList;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 List:=TSuperList.Create(self);
 List.Top:=50; List.Left:=50;
 List.Visible:=true;
 List.Parent:=Form1;
end;

end.

SuperList.pas

unit SuperList;

interface

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

type

  TSuperList = class(TCustomControl)
  public
    DX,DY: integer;
    ScrollBar: TScrollBar;
    procedure   Paint; override;
    constructor Create(AOwner: TComponent); override;
    procedure   WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure   WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure   WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  published
    property    OnMouseMove;
    property    OnKeyPress;
    property    OnKeyDown;
    property    Color default clWindow;
    property    TabStop default true;
    property    Align;
    property    DoubleBuffered default true;
    property    BevelEdges;
    property    BevelInner;
    property    BevelKind default bkFlat;
    property    BevelOuter;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Marus', [TSuperList]);
end;

procedure TSuperList.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
 inherited;
 Message.Result:= Message.Result or DLGC_WANTARROWS;
end;

procedure TSuperList.WMKeyDown(var Message: TWMKeyDown);
begin
 if Message.CharCode=VK_LEFT  then begin dec(DX,3); Invalidate; exit; end;
 if Message.CharCode=VK_RIGHT then begin inc(DX,3); Invalidate; exit; end;
 if Message.CharCode=VK_UP    then begin dec(DY,3); Invalidate; exit; end;
 if Message.CharCode=VK_DOWN  then begin inc(DY,3); Invalidate; exit; end;
 inherited;
end;

procedure TSuperList.WMLButtonDown(var Message: TWMLButtonDown);
begin
 DX:=Message.XPos;
 DY:=Message.YPos;
 SetFocus;
 Invalidate;
 inherited;
end;

constructor TSuperList.Create(AOwner: TComponent);
begin
 inherited;
 DoubleBuffered:=true;
 TabStop:=true;
 Color:=clNone; Color:=clWindow;
 BevelKind:=bkFlat;
 Width:=200;
 Height:=100;
 DX:=5; DY:=50;
 ScrollBar:=TScrollBar.Create(self);
 ScrollBar.Kind:=sbVertical;
 ScrollBar.TabStop:=false;
 ScrollBar.Align:=alRight;
 ScrollBar.Visible:=true;
 ScrollBar.Parent:=self;
end;

procedure TSuperList.Paint;
begin
 Canvas.Brush.Color:=Color;
 Canvas.FillRect(Canvas.ClipRect);
 Canvas.TextOut(10,10,'Press arrow keys !');
 Canvas.Brush.Color:=clRed;
 Canvas.Pen.Color:=clBlue;
 Canvas.Rectangle(DX,DY,DX+30,DY+20);
end;

end.

Answer 1

I think the first thing that I would do is remove that scroll bar control. Windows come with ready made scroll bars. You just need to enable them.

So, start by removing ScrollBar from the component. Then add a CreateParams override:

procedure CreateParams(var Params: TCreateParams); override;

Implement it like this:

procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_VSCROLL;
end;

Yippee, your control now has a scroll bar.

Next you need to add a handler for WM_VSCROLL:

procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;

And that's implemented like this:

procedure TSuperList.WMVScroll(var Message: TWMVScroll);
begin
  case Message.ScrollCode of
  SB_LINEUP:
    begin
      dec(DY, 3);
      Invalidate;
    end;
  SB_LINEDOWN:
    begin
      inc(DY, 3);
      Invalidate;
    end;
  ... 
  end;
end;

You'll need to fill out the rest of the scroll codes.

I would also suggest that you do not set DoubleBuffered in the constructor of your component. Let the user set that if they wish. There's no reason for your control to require double buffering.