为啥我的滚动条并不总是正确绘制?

Posted

技术标签:

【中文标题】为啥我的滚动条并不总是正确绘制?【英文标题】:Why my scrollbar is not always painted correctly?为什么我的滚动条并不总是正确绘制? 【发布时间】:2014-12-02 10:39:49 【问题描述】:

我有一个图形化的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.

【问题讨论】:

不确定您的问题,因为我尚未对其进行测试。但是快速查看您的代码会显示一个错误,该错误可能会在将来困扰您。这是什么错误。在您的组件类型定义中,您将 TabStop 属性设置为已发布,以便它在 ObjectInspector 中可见,因此允许用户根据需要将其设置为 True 或 False,但在组件构造函数中,您始终将 TabStop 设置为 True 从而覆盖 TabStop 值在设计时设置。这可能会惹恼您的用户,因为在设计时更改该值不会产生任何影响。所以你最终会得到一个很快被忽视的错误。 不,这不是错误。构造函数只执行一次,当您将组件放在表单上时,您可以根据需要更改属性的值。我已经测试过了。 您不应该在控件的代码中设置 DoubleBuffered。同样的 TabStop。 SilverWarrior 的评论是准确的。 @Silver & David 不,这不是错误,因为 TabStop 属性具有正确的默认说明符。设计时设置在组件创建后加载。 Marus 是正确的,这不会给组件的用户带来麻烦。 已确认:D7 中的错误,至少在 XE2 中已修复。这似乎与Bugfix for BorderWidth > 0 in combination with a scroll bar?有关。 【参考方案1】:

问题是因为设置BevelKind:=bkFlat;

在绘制控件的非客户区期间调用 TWinControl.WMNCPaint 时,这将覆盖滚动条。

作为一种快速的解决方法,您可以将 WMNCPaint 添加到您的控件并将 Region 更改为 1。Delphi 将重新绘制整个非客户区,这样会更好一些。

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;

更简洁的解决方案是自行实施斜角绘画。这将减少闪烁。

【讨论】:

我把它放在那里是因为 TWinControl 使用原始 RGN 句柄调用 DefaultHandler。可能不需要。 谢谢!它工作得很好,而且我没有闪烁。但是如果我想按照您的建议尝试自己绘制斜面,我应该在WM_PAINTWM_NCPAINT 中进行绘制? 如果你的控件使用WMNCCalcSize计算非客户区(如果你设置了BevelKind就是这种情况),那么你应该在WM_NCPaint中绘制斜角。

以上是关于为啥我的滚动条并不总是正确绘制?的主要内容,如果未能解决你的问题,请参考以下文章

如何隐藏滚动条并使内容可滚动? [复制]

如何隐藏窗口滚动条并使滚动仍然有效[重复]

如何启用垂直滚动的滚动条并禁用水平滚动?

如何隐藏水平滚动条并保持垂直滚动条可见,同时仍然能够水平滚动?

css设置滚动条并显示或隐藏

如何隐藏scroll-Y纵向滚动条,并不影响内容滚动的方法