How to make my TCustomControl descendant component stop flickering? - delphi

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.