2014-10-07 50 views
3

我有它的系統滾動條的圖形TCustomControl後裔組成部分。問題是,當我將窗口移動到屏幕外部並將其拖回時,滾動條會消失(不會被繪製)。我怎樣才能解決這個問題 ?我在想,也許我應該在組件Paint中調用滾動條Paint方法,但我不知道如何。爲什麼我的滾動條並不總是正確繪製?

這是代碼。有沒有需要安裝的組件或放東西的主要形式,只需將代碼複製並分配TForm1.FormCreate事件:

Unit1.pas

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, SuperList; 

type 
    TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    end; 

var 
    Form1: TForm1; 
    List: TSuperList; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
List:=TSuperList.Create(self); 
List.AlignWithMargins:=true; 
List.Align:=alClient; 
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; 
    procedure Paint; override; 
    constructor Create(AOwner: TComponent); override; 
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; 
    procedure CreateParams(var Params: TCreateParams); override; 
    published 
    property TabStop default true; 
    property Align; 
    end; 

procedure Register; 

implementation 

procedure Register; 
begin 
    RegisterComponents('Marus', [TSuperList]); 
end; 

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

procedure TSuperList.WMLButtonDown(var Message: TWMLButtonDown); 
begin 
DX:=Message.XPos; 
DY:=Message.YPos; 
Invalidate; 
inherited; 
end; 

constructor TSuperList.Create(AOwner: TComponent); 
begin 
inherited; 
DoubleBuffered:=true; 
TabStop:=true; 
Color:=clBtnFace; 
BevelKind:=bkFlat; 
Width:=200; Height:=100; 
DX:=50; DY:=50; 
end; 

procedure TSuperList.Paint; 
begin 
Canvas.Brush.Color:=clWindow; 
Canvas.FillRect(Canvas.ClipRect); 
Canvas.TextOut(10,10,'Press left mouse button !'); 
Canvas.Brush.Color:=clRed; 
Canvas.Pen.Color:=clBlue; 
Canvas.Rectangle(DX,DY,DX+30,DY+20); 
end; 

end. 
+0

不知道你的問題,因爲我還沒有測試出來。但快速瀏覽一下你的代碼會發現一個可能會在未來出錯的錯誤。這是什麼錯誤。在你的組件類型定義所做tab屬性爲出版,使其在ObjectInspector是可見的,因此alow用戶將其設置爲True或False根據自己的需要,但您總是在接受tab爲True超然的接受tab值的組件構造在設計時設定。這可能會讓你的用戶感到厭惡,因爲在設計時刻這個價值就沒有用處了。所以你最終得到一個很容易被忽視的bug。 – SilverWarior 2014-10-07 22:33:32

+0

不,這不是一個錯誤。當您將組件放在窗體上時,構造函數只執行一次,之後您可以根據需要更改該屬性的值。我測試過了。 – 2014-10-07 23:10:17

+0

您不應該在控件的代碼中設置DoubleBuffered。同樣TabStop。 SilverWarrior的評論是準確的。 – 2014-10-08 07:20:07

回答

3

問題是因爲設置BevelKind:=bkFlat;

在繪製控件的非客戶區期間調用TWinControl.WMNCPaint時,這將覆蓋滾動條。

作爲一個快速的解決方法,你可以添加WMNCPaint到您的控制和改變地區爲1德爾福將重新繪製,然後整個非客戶端區域,其工作好一點。

procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; 

procedure TSuperList.WMNCPaint(var Message: TWMNCPaint); 
var 
    TmpRgn: HRGN; 
begin 
    TmpRgn := Message.RGN; 
    try 
    Message.RGN := 1; 
    inherited; 
    finally 
    Message.RGN := TmpRgn; 
    end; 
    // if you want to add some custom NC painting, you could do it here... 
end; 

更清潔的解決方案將自己實施斜角繪畫。這會減少閃爍。

+1

+1爲什麼'DefaultHandler'? – NGLN 2014-10-08 07:48:40

+0

我在那裏,因爲TWinControl調用DefaultHandler與原始RGN句柄。這可能不需要。 – 2014-10-08 10:29:02

+0

謝謝!它工作得很好,我沒有閃爍。但是,如果我想嘗試自己繪製斜面,按照您的建議,我應該在WM_PAINT或WM_NCPAINT中繪畫? – 2014-10-08 16:10:16

相關問題