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

我有一个图形化的

TCustomControl

子组件，上面有一个系统滚动条。问题是，当我将窗口移到屏幕外的一半，然后将其向后拖动时，滚动条消失（没有绘制）。我怎样才能解决这个问题？我在想，也许我应该调用component

Paint

中的滚动条

Paint

方法，但我不知道如何调用

这是代码。无需安装组件或在主窗体上添加内容，只需复制代码并为m1分配

t。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.

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.

SuperList.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.

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.

---

问题在于设置

BevelKind:=bkFlat

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

作为一种快速解决方法，您可以将WMNCPaint添加到控件并将区域更改为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;

一个更清洁的解决方案是自己实施斜面喷漆。这将减少闪烁。
我不确定您的问题，因为我还没有测试出来。但是，快速查看一下您的代码，就会发现一个错误，将来可能会给您带来麻烦。这个错误是什么。在组件类型定义中，您将TabStop属性设置为已发布，以便它在ObjectInspector中可见，从而允许用户根据需要将其设置为True或False，但在组件构造函数中，您始终将TabStop设置为True，从而覆盖在设计时设置的TabStop值。这可能会激怒您的用户，因为在设计时更改该值不会产生任何效果。所以你很快就会发现一个被忽略的错误。不，这不是一个错误。当您将组件放到表单上时，构造函数只执行一次，之后您可以根据需要更改属性的值。我已经测试过了。你不应该在控件的代码中设置DoubleBuffered。同样，停止。SilverWarrior的评论是准确的。@Silver&David否，这不是错误，因为
TabStop
属性具有正确的默认说明符。设计时间设置在组件创建后加载。Marus是正确的，这不会给组件的用户带来麻烦。确认：D7中有bug，至少在XE2中修复了。这似乎与。我把它放在那里，因为TWinControl使用原始RGN句柄调用DefaultHandler。可能不需要。谢谢！它工作得很好，我没有闪烁。但是，如果我想按照您的建议尝试自己绘制斜面，我应该在哪里进行绘制，在
WM_-PAINT
或
WM_-NCPAINT
中？如果您的控件使用
WMNCCalcSize
计算非客户端区域（如果设置了BevelKind，则是这种情况），那么您应该在WM_-NCPAINT中绘制斜面。