2014-09-30 23 views
7

Ich habe eine grafische TCustomControl Nachfahrerkomponente mit einem TScrollBar drauf. Das Problem ist, dass, wenn ich die Pfeiltaste zum Verschieben des Mauszeigers die gesamte Leinwand in Hintergrundfarbe einschließlich der Region der Bildlaufleiste gemalt wird, dann wird die Bildlaufleiste neu gezeichnet und die Bildlaufleiste flackert. Wie kann ich das lösen?Wie kann ich verhindern, dass meine TCustomControl-Komponente flackert?

Hier ist der Code. Es besteht keine Notwendigkeit, die Komponente installieren oder etwas auf dem Hauptformular zu setzen, kopieren Sie einfach den Code und weisen TForm1.FormCreate Ereignis:

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. 
+0

Haben Sie eine Zwischenpuffer-Bitmap ausprobiert? Die Idee ist, alle Ihre Zeichnung auf einer unsichtbaren Leinwand zu machen, dann, wenn Sie fertig sind, malen Sie dieses Bild zu Ihrer Kontrolle. –

+0

Ich hätte gesagt, dass das Parsen einer Bildlaufleiste ein Problem sein wird. Ich denke, es wäre besser, wenn Sie das vom System übernehmen würden. Und die Einstellung 'DoubleBuffered' auf' True' in der Steuerung erscheint zweifelhaft. Sie sollten keinen doppelten Puffer benötigen. +1 für eine sehr nette Frage, mit all dem Code, den wir brauchen, schneiden Sie sehr gut ab. –

+0

@JerryDodge Ja. Die Eigenschaft 'DoubleBuffered' ist aktiviert und alle Zeichnungen werden zuerst auf der unsichtbaren Bitmap erstellt. –

Antwort

5

Ich denke, das erste, was ich tun würde, ist das Bildlaufleiste Steuerelement zu entfernen. Windows wird mit vorgefertigten Scrollbars geliefert. Sie müssen sie nur aktivieren.

Beginnen Sie also damit, ScrollBar aus der Komponente zu entfernen. Dann fügen Sie eine CreateParams Überschreibung:

procedure CreateParams(var Params: TCreateParams); override; 

Implementieren es wie folgt aus:

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

Yippee, Ihre Steuerung verfügt nun über eine Bildlaufleiste.

Als nächstes müssen Sie einen Handler für WM_VSCROLL hinzuzufügen:

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

Und das ist, wie dies umgesetzt:

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; 

Sie werden den Rest des Scroll-Codes ausfüllen müssen.

Ich würde auch vorschlagen, dass Sie DoubleBuffered nicht im Konstruktor Ihrer Komponente festlegen. Lassen Sie den Benutzer das einstellen, wenn sie es wünschen. Es gibt keinen Grund für Ihre Kontrolle, doppelte Pufferung zu erfordern.

+0

Yeeees, das ist es! Kein Flimmern mehr. Vielen Dank David Heffernan!:) –

+2

In einem Scroll-Message-Handler sollten Sie lieber die 'ScrollWindowEx'-Funktion als' Invalidate' verwenden (auch wenn Sie das gesamte Client-Rechteck ungültig machen). '' – TLama

+1

@TLama Danke. Ich bin an dieser Stelle überfordert. –