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.
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. –
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. –
@JerryDodge Ja. Die Eigenschaft 'DoubleBuffered' ist aktiviert und alle Zeichnungen werden zuerst auf der unsichtbaren Bitmap erstellt. –