我想制作一个具有可选边框大小的自定义控件。请参阅下面的代码。边框绘制在非客户区域中,其宽度可以是0,1或2像素。我已成功完成了WM_NCPAINT
中的边框绘制。问题是,在我更改控制边框大小的属性后,我不知道如何告诉系统重新计算客户端和非客户端区域的新维度。我注意到当我调整窗口大小(使用鼠标)时会应用更改,但在更改边框大小后,我不知道如何立即执行此操作。
SuperList.pas
unit SuperList;
interface
uses Windows, Controls, Graphics, Classes, Messages, SysUtils, StdCtrls, UxTheme;
type
TBorderType = (btNone, btSingle, btDouble);
TSuperList = class(TCustomControl)
private
HHig,HMidH,HMidL,HLow:TColor;
BCanvas: TCanvas;
FBorderSize: TBorderType;
procedure SetBorderSize(const Value:TBorderType);
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
protected
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner:TComponent); override;
published
property BorderType:TBorderType read FBorderSize write SetBorderSize default btDouble;
end;
implementation
constructor TSuperList.Create(AOwner:TComponent);
begin
inherited;
BCanvas:=TCanvas.Create;
FBorderSize:=btDouble;
HHig:=clWhite; HMidH:=clBtnFace; HMidL:=clGray; HLow:=cl3DDkShadow;
end;
procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_VSCROLL or WS_HSCROLL;
end;
procedure TSuperList.SetBorderSize(const Value:TBorderType);
begin
if Value<>FBorderSize then begin
FBorderSize:=Value;
// .... ?????? I think here must be done something...
Perform(WM_NCPAINT,1,0); // repainting the non-client area (I do not know how can I invalidate the non-client area differently)
Invalidate; // repainting the client area
// I've tried even with the... RedrawWindow(Handle,nil,0,RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW or RDW_INTERNALPAINT);
end;
end;
procedure TSuperList.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result:=1;
end;
procedure TSuperList.WMSize(var Message: TWMSize);
begin
inherited;
Perform(WM_NCPAINT,1,0);
end;
procedure TSuperList.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
inherited;
if FBorderSize>btNone then
InflateRect(Message.CalcSize_Params^.rgrc0,-Integer(FBorderSize),-Integer(FBorderSize));
end;
procedure TSuperList.Paint;
begin
Canvas.Brush.Color:=clWhite;
Canvas.FillRect(ClientRect);
end;
procedure TSuperList.WMNCPaint(var Message: TWMNCPaint);
var DC: HDC;
R: TRect;
HS_Size,VS_Size:Integer;
HS_Vis,VS_Vis:Boolean;
begin
inherited;
Message.Result:=0;
if FBorderSize>btNone then
begin
DC:=GetWindowDC(Handle); if DC=0 then Exit;
BCanvas.Handle:=DC;
BCanvas.Pen.Color:=clNone;
BCanvas.Brush.Color:=clNone;
try
VS_Size:=GetSystemMetrics(SM_CXVSCROLL);
HS_Size:=GetSystemMetrics(SM_CYHSCROLL);
VS_Vis:=GetWindowLong(Handle,GWL_STYLE) and WS_VSCROLL <> 0;
HS_Vis:=GetWindowLong(Handle,GWL_STYLE) and WS_HSCROLL <> 0;
R:=ClientRect;
OffsetRect(R,Integer(FBorderSize),Integer(FBorderSize));
if VS_Vis and HS_Vis then begin
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom+HS_Size);
ExcludeClipRect(DC, R.Left, R.Top, R.Right+VS_Size, R.Bottom);
BCanvas.Brush.Color:=HMidH;
R.Right:=Width-Integer(FBorderSize); R.Left:=R.Right-VS_Size;
R.Bottom:=Height-Integer(FBorderSize); R.Top:=R.Bottom-HS_Size;
BCanvas.FillRect(R);
end else begin
if VS_Vis then Inc(R.Right,VS_Size);
if HS_Vis then Inc(R.Bottom,HS_Size);
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
end;
BCanvas.MoveTo(0,Height-1);
BCanvas.Pen.Color:=HMidL; BCanvas.LineTo(0,0); BCanvas.LineTo(Width-1,0);
if IsThemeActive then begin
BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(Width-1,Height-1);
BCanvas.LineTo(-1,Height-1);
end else begin
if FBorderSize=btDouble then begin
BCanvas.Pen.Color:=HHig;
BCanvas.LineTo(Width-1,Height-1);
BCanvas.LineTo(-1,Height-1);
end else begin
if VS_Vis then BCanvas.Pen.Color:=HHig else BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(Width-1,Height-1);
if HS_Vis then BCanvas.Pen.Color:=HHig else BCanvas.Pen.Color:=HMidL;
BCanvas.LineTo(-1,Height-1);
end;
end;
if FBorderSize=btDouble then begin
BCanvas.MoveTo(1,Height-2);
BCanvas.Pen.Color:=HLow; BCanvas.LineTo(1,1); BCanvas.LineTo(Width-2,1);
BCanvas.Pen.Color:=HMidH; BCanvas.LineTo(Width-2,Height-2); BCanvas.LineTo(0,Height-2);
end;
finally
ReleaseDC(Handle,DC);
end;
end;
end;
end.
Unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SuperList, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
public
List: TSuperList;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
List:=TSuperList.Create(self);
List.Parent:=Form1;
List.Margins.Left:=20; List.Margins.Right:=20;
List.Margins.Top:=50; List.Margins.Bottom:=20;
List.AlignWithMargins:=true;
List.Align:=alClient;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
List.BorderType:=btNone;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
List.BorderType:=btSingle;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
List.BorderType:=btDouble;
end;
end.
答案 0 :(得分:6)
发送CM_BORDERCHANGED
条消息:
Perform(CM_BORDERCHANGED, 0, 0);
这将触发TWinControl
中的处理程序:
procedure TWinControl.CMBorderChanged(var Message: TMessage);
begin
inherited;
if HandleAllocated then
begin
SetWindowPos(Handle, 0, 0,0,0,0, SWP_NOACTIVATE or
SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_FRAMECHANGED);
if Visible then
Invalidate;
end;
end;
来自SetWindowPos
的文档:
SWP_FRAMECHANGED
:应用使用SetWindowLong
功能设置的新帧样式。即使窗口的大小未更改,也会向窗口发送WM_NCCALCSIZE
消息。如果未指定此标志,则仅在更改窗口大小时才会发送WM_NCCALCSIZE
。