Làm sao để thành phần hậu duệ TCustomControl của tôi ngừng nhấp nháy?

Question

Tôi có một thành phần hậu duệ TCustomControl đồ họa với một số TScrollBar trên đó. Vấn đề là khi tôi nhấn phím mũi tên để di chuyển con trỏ, toàn bộ canvas được tô màu nền, bao gồm cả vùng của thanh cuộn, sau đó thanh cuộn được sơn lại và làm cho thanh cuộn nhấp nháy. Làm sao tôi có thể giải quyết việc này ?

Đây là mã. Không cần phải cài đặt các thành phần hoặc đặt một cái gì đó về hình thức chính, chỉ cần sao chép mã và gán TForm1.FormCreate sự kiện:

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

Tôi nghĩ rằng điều đầu tiên mà tôi sẽ làm là loại bỏ điều khiển thanh cuộn. Windows đi kèm với các thanh cuộn sẵn sàng. Bạn chỉ cần kích hoạt chúng.

Vì vậy, hãy bắt đầu bằng cách xóa ScrollBar khỏi thành phần. Sau đó, thêm một ghi đè CreateParams:

procedure CreateParams(var Params: TCreateParams); override; 

Thực hiện nó như thế này:

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

Yippee, kiểm soát của bạn bây giờ có một thanh cuộn.

Tiếp theo, bạn cần phải thêm một handler cho WM_VSCROLL:

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

Và đó là thực hiện như thế này:

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; 

Bạn sẽ cần phải điền vào phần còn lại của mã di chuyển.

Tôi cũng khuyên bạn không nên đặt DoubleBuffered trong hàm tạo của thành phần của bạn. Cho phép người dùng đặt rằng nếu họ muốn. Không có lý do gì để kiểm soát của bạn yêu cầu đệm đôi.