我有一个自定义控件,同时启用了两个滚动条,我想在客户区和滚动条周围绘制一个简单的红线边框,如下图所示。我是怎么做到的
这是控制代码:
unit SuperList;
interface
uses Windows, Controls, Graphics, Classes, Messages, SysUtils, StdCtrls;
type
TSuperList = class(TCustomControl)
protected
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
implementation
procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style:=Params.Style or WS_VSCROLL or WS_HSCROLL;
end;
constructor TSuperList.Create(AOwner: TComponent);
begin
inherited;
Color:=clBlack;
Width:=300;
Height:=250;
end;
procedure TSuperList.Paint;
begin
Canvas.Pen.Color:=clNavy;
Canvas.Brush.Color:=clWhite;
Canvas.Rectangle(ClientRect); // a test rectangle te see the client area
end;
end.
答案 0 :(得分:4)
发布BorderWidth
属性,并实施WM_NCPAINT
消息处理程序,如this answer中所示,并结合this answer中的代码:
type
TSuperList = class(TCustomControl)
private
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property BorderWidth default 10;
end;
implementation
constructor TSuperList.Create(AOwner: TComponent);
begin
inherited Create(Aowner);
ControlStyle := ControlStyle - [csOpaque];
BorderWidth := 10;
end;
procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_VSCROLL or WS_HSCROLL;
Params.WindowClass.style :=
Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
procedure TSuperList.Paint;
begin
Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255));
Canvas.FillRect(Canvas.ClipRect);
end;
procedure TSuperList.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TSuperList.WMNCPaint(var Message: TWMNCPaint);
var
DC: HDC;
R: TRect;
WindowStyle: Integer;
begin
inherited;
if BorderWidth > 0 then
begin
DC := GetWindowDC(Handle);
try
R := ClientRect;
OffsetRect(R, BorderWidth, BorderWidth);
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
WindowStyle := GetWindowLong(Handle, GWL_STYLE);
if WindowStyle and WS_VSCROLL <> 0 then
ExcludeClipRect(DC, R.Right, R.Top,
R.Right + GetSystemMetrics(SM_CXVSCROLL), R.Bottom);
if WindowStyle and WS_HSCROLL <> 0 then
ExcludeClipRect(DC, R.Left, R.Bottom, R.Right,
R.Bottom + GetSystemMetrics(SM_CXHSCROLL));
SetRect(R, 0, 0, Width + BorderWidth, Height + BorderWidth);
Brush.Color := clRed;
FillRect(DC, R, Brush.Handle);
finally
ReleaseDC(Handle, DC);
end;
end;
Message.Result := 0;
end;
答案 1 :(得分:3)
您正试图在Nonclient Area中绘制(部分)
您可以将WS_DLGFRAME
添加到Params.Style
并处理消息WM_NCPaint
在窗户的HDC上绘画。
TSuperList = class(TCustomControl)
private
procedure PaintBorder;
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCActivate;
procedure WMNCPaint(var Msg: TWMNCPaint);message WM_NCPaint;
protected
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style:=Params.Style or WS_VSCROLL or WS_HSCROLL or WS_DLGFRAME;
end;
procedure TSuperList.WMNCActivate(var Msg: TWMNCActivate);
begin
inherited;
PaintBorder;
end;
procedure TSuperList.WMNCPaint(var Msg: TWMNCPaint);
begin
inherited;
PaintBorder;
end;
procedure TSuperList.PaintBorder;
begin
Canvas.Handle := GetWindowDC(Handle);
Canvas.Pen.Color := clNavy;
Canvas.Pen.Width := 2;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle( Rect(1,1,Width,Height) );
ReleaseDC(Handle,Canvas.Handle);
end;
constructor TSuperList.Create(AOwner: TComponent);
begin
inherited;
Color:=clBlack;
Width:=300;
Height:=250;
end;
procedure TSuperList.Paint;
begin
Canvas.Brush.Color:=clWhite;
Canvas.Pen.Style := psClear;
Canvas.Rectangle(ClientRect);
Canvas.Pen.Style := psSolid;
Canvas.Ellipse(0,0,20,20);
end;