我正在尝试使用滚动条在自定义控件的客户区域周围绘制彩色边框。为此,我设置BorderWidth
为一个正整数并响应WM_NCPAINT
消息。这听起来像是混合了 VCL 和 Win32,但该BorderWidth
属性只会导致对WM_NCCALCSIZE
消息的适当处理。
以下代码是SSCCE:
unit Unit6;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TSample = class(TCustomControl)
protected
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
published
property BorderWidth;
end;
TForm6 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form6: TForm6;
implementation
{$R *.dfm}
{ TSample }
procedure TSample.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_VSCROLL or WS_HSCROLL;
end;
procedure TSample.Paint;
begin
inherited;
Canvas.Brush.Color := clWhite;
Canvas.FillRect(ClientRect);
end;
procedure TSample.WMNCPaint(var Message: TWMNCPaint);
var
dc: HDC;
R: TRect;
begin
DefaultHandler(Message);
dc := GetWindowDC(Handle);
try
Brush.Color := clYellow;
GetWindowRect(Handle, R);
with R do
R := Rect(0, 0, Right - Left, Bottom - Top);
ExcludeClipRect(dc, BorderWidth, BorderWidth,
R.Right - BorderWidth, R.Bottom - BorderWidth);
FillRect(dc, R, Brush.Handle);
finally
ReleaseDC(Handle, dc);
end;
end;
procedure TForm6.FormCreate(Sender: TObject);
begin
with TSample.Create(self) do
begin
Parent := Self;
SetBounds(10, 10, 500, 100);
BorderWidth := 10;
end;
end;
end.
结果如下所示:
除了右下角的正方形外,这看起来很完美。这个区域很容易通过做一些事情来修复;我故意不画这个区域,因为它与我试图描述的实际问题无关。所以请忽略那个正方形。
现在,我可以通过拖动它的右边框来调整它的大小。我先把它变小,这样样例控制窗口的垂直滚动条就被隐藏了。然后我慢慢放大表格,使示例控件再次完全可见。然后它看起来像这样:
在这里你可以看到问题:BorderSize
垂直滚动条的最左边的像素似乎不是由操作系统绘制的。
一些观察:
- 使用完整
inherited
而不是单纯DefaltHandler(Message)
会使问题变得更糟。在这种情况下,黄色区域将在窗体暂时移出屏幕后以及在控件遮挡窗体收缩增长操作后完全遮挡滚动条。
实现对
WM_NCHITTEST
消息的匹配响应会使控件以更好的方式运行,但不能解决滚动条绘制问题。我知道如何在带有滚动条的控件的非客户区域内绘制自定义边框?; 这个问题的答案都受到上述问题的影响。
我正在使用 Delphi 2009 和 Windows 7 Home Premium,64 位,启用 Aero。