为什么我的滚动条并不总是正确绘制？

我有它的系统滚动条的图形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.

来源

2014-10-07 Marus Nebunu

不知道你的问题，因为我还没有测试出来。但快速浏览一下你的代码会发现一个可能会在未来出错的错误。这是什么错误。在你的组件类型定义所做tab属性为出版，使其在ObjectInspector是可见的，因此alow用户将其设置为True或False根据自己的需要，但您总是在接受tab为True超然的接受tab值的组件构造在设计时设定。这可能会让你的用户感到厌恶，因为在设计时刻这个价值就没有用处了。所以你最终得到一个很容易被忽视的bug。 – SilverWarior 2014-10-07 22:33:32

不，这不是一个错误。当您将组件放在窗体上时，构造函数只执行一次，之后您可以根据需要更改该属性的值。我测试过了。 – 2014-10-07 23:10:17

您不应该在控件的代码中设置DoubleBuffered。同样TabStop。 SilverWarrior的评论是准确的。 – 2014-10-08 07:20:07

问题是因为设置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;

更清洁的解决方案将自己实施斜角绘画。这会减少闪烁。

来源

2014-10-08 05:41:55

+1为什么'DefaultHandler'？ – NGLN 2014-10-08 07:48:40

我在那里，因为TWinControl调用DefaultHandler与原始RGN句柄。这可能不需要。 – 2014-10-08 10:29:02

谢谢！它工作得很好，我没有闪烁。但是，如果我想尝试自己绘制斜面，按照您的建议，我应该在WM_PAINT或WM_NCPAINT中绘画？ – 2014-10-08 16:10:16

为什么我的滚动条并不总是正确绘制？

回答

相关问题