Come rendere il mio componente discendente TCustomControl smettere di sfarfallio?

Question

Ho un componente discendente grafico TCustomControl con un TScrollBar su di esso. Il problema è che quando premo il tasto freccia per spostare il cursore, l'intera tela viene dipinta con il colore di sfondo, inclusa la regione della barra di scorrimento, quindi la barra di scorrimento viene ridipinta e ciò rende lo sfarfallio della barra di scorrimento. Come posso risolvere questo ?

Ecco il codice. Non è necessario installare il componente o di mettere qualcosa sulla forma principale, basta copiare il codice e assegnare TForm1.FormCreate evento:

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

Penso che la prima cosa che farei sia rimuovere il controllo della barra di scorrimento. Le finestre sono dotate di barre di scorrimento già pronte. Hai solo bisogno di abilitarli.

Quindi, iniziare rimuovendo ScrollBar dal componente. Quindi aggiungere un CreateParams di override:

procedure CreateParams(var Params: TCreateParams); override; 

implementarlo in questo modo:

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

Yippee, il vostro controllo ora ha una barra di scorrimento.

Dopodiché è necessario aggiungere un gestore per WM_VSCROLL:

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

e che è implementato in questo modo:

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; 

Dovrai compilare il resto dei codici di scorrimento.

Vorrei anche suggerire di non impostare DoubleBuffered nel costruttore del componente. Lascia che l'utente lo imposti se lo desidera. Non c'è motivo per il tuo controllo di richiedere il doppio buffering.