Delphi组件开发-在窗体标题栏添加按钮

这是一个在窗体标题栏添加自定义按钮的组件（TTitleBarButton）开发实例，标题栏按钮组件TTitleBarButton以TComponent为直接继承对象，它是一个可以在窗体标题栏上显示按钮的组件，像最大化、最小化和关闭按钮等。

1、首先确定组件的属性。

属性是组件的重要组成部分，它相当于组件的门面，因为一旦一个组件被置于窗体中时，用户必然想到去设置组件的各种属性，编写各种事件的处理过程。TTitleBarButton有以下属性：

Color：用来决定按钮表面的颜色。
Glyph：用来决定按钮表面的图片。
PopupMenu：用来决定右键单击按钮时的弹出菜单。
RightMargin：用来确定按钮的位置，以窗体右边界为基准。
Visible：用来决定按钮是否可见。

2、确定组件的方法。

方法是组件的基本构成部分之一，在编写方法时，尽量减少方法间的依赖关系，并确定方法的可见度，以及是否为虚函数等。在本例中，主要方法如下：

function GetBoundsRect: TRect;?? 用来确定按钮的边界矩形，可见度为private
procedure NewWndProc(var message: TMessage);? 窗体的新的窗口过程，private
procedure Paint; virtual; 该类的继承者可以override该方法，但用户不能直接调该方法
procedure Repaint; 是Paint方法的对外接口，用户可以调用此方法，以强制重新画按钮

3、确定组件的事件。

事件实际上是一种特殊的属性，它也是组件的很重要组成部分，事件为组件响应系统发生的行为而执行的一段代码连接。事件就是方法指针，是方法的触发器。TtitleBarButton只有一个事件：
OnClick事件，用来响应用户的Click事件代码。
?
4、另外，要减少组件的依赖关系。

使一个组件在执行其代码时所受的约束尽可能地少，这是开发组件的一个主要目标，它也是衡量一个组件性能好坏的重要标准之一。?

实现标题栏按钮需要解决以下主要问题：
（1）? 如何确定按钮的边界，即Left，Top，Width，Height
通过GetWindowRect来取得窗体的边界矩形，通过GetSystemMetrics取得窗体的框架宽度和标题栏按钮的高度、宽度。再加上RightMargin属性就可以基本上确定按钮的边界了。

（2）? 如何画按钮的外观（包括按下和凸起）

通过GetWindowDC来取得窗体DC（包括标题栏、菜单、滚动条等），我们就可以在这个DC上画按钮了。

（3）? 如何让按钮响应消息（比如Click，单击右键弹出菜单等）

我们可以通过GetWindowLong取得窗体的窗口过程，然后把我们新定义的窗口过程通过SetWindowLong给这个窗体，然后我们在自己的窗口过程中来让按钮响应消息。

全部代码如下：

unit TitleBarButton;

interface

uses

?? Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Menus,Dialogs;

type

? TTitleBarButton = class(TComponent)

? private
??? FColor: TColor;
??? FGlyph: TBitmap;
??? FForm: TCustomForm;
??? FOldWndProc: Pointer;
??? FButtonDown: Boolean;
??? FVisible: Boolean;
??? FRightMargin: Cardinal;
??? FPopup: TPopupMenu;
??? FOnClick: TNotifyEvent;
??? procedure SetGlyph(const Value: TBitmap);
??? procedure SetVisible(const Value: Boolean);
??? procedure SetRightMargin(const Value: Cardinal);
??? function GetBoundsRect: TRect;
??? procedure NewWndProc(var message: TMessage);

? protected
??? procedure Notification(Component: TComponent;Operation: TOperation); override;
??? procedure Paint; virtual;

? public
??? constructor Create(AOwner: TComponent); override;
??? destructor Destroy; override;
??? procedure Repaint;
??? property BoundsRect: TRect read GetBoundsRect;

? published
??? property Color: TColor read FColor write FColor default clBtnFace;
??? property Glyph: TBitmap read FGlyph write SetGlyph;
??? property PopupMenu: TPopupMenu read FPopup write FPopup;
??? property RightMargin: Cardinal read FRightMargin write SetRightMargin default 100;
??? property Visible: Boolean read FVisible write SetVisible default False;
??? property OnClick: TNotifyEvent read FOnClick write FOnClick;

? end;

procedure Register;

implementation

procedure Register;

begin
? RegisterComponents('Sample',[TTitleBarButton]);
end;

{ TTitleBarButton }

constructor TTitleBarButton.Create(AOwner: TComponent);
var
? ptr: Pointer;
begin
? inherited;
? FForm := GetParentForm(TControl(AOwner));
? FGlyph := TBitmap.Create;
? FColor := clBtnFace;
? FVisible := False;
? FRightMargin := 100;
? FButtonDown := False;
? FOldWndProc := Pointer(GetWindowLong(FForm.Handle,GWL_WNDPROC));
? ptr := MakeObjectInstance(NewWndProc);
? SetWindowLong(FForm.Handle,GWL_WNDPROC,Longint(ptr));
end;

destructor TTitleBarButton.Destroy;
begin
? if not (csDestroying in FForm.ComponentState) then
? begin
??? SetVisible(false);
??? SetWindowLong(FForm.Handle,LongInt(FOldWndProc));
? end;
? FGlyph.Free;
? inherited;
end;

procedure TTitleBarButton.NewWndProc(var message: TMessage);
? function HitButton(APoint: TPoint): Boolean;
? begin
??? APoint.x := APoint.x - FForm.Left;
??? APoint.y := APoint.y - FForm.Top;
??? Result := PtInRect(BoundsRect,APoint);
? end;
var
? p: TPoint;
begin
? with message do
? begin
??? if Visible then
??? begin
????? case Msg of
??????? WM_NCPAINT,WM_NCACTIVATE :
????????? begin
??????????? Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);
??????????? RePaint;
????????? end;
??????? WM_NCHITTEST :
????????? begin
??????????? Result := CallWindowProc(FOldWndProc,LParam);
??????????? if Result = HTCAPTION then
??????????? begin
????????????? RePaint;
????????????? p.x := LoWord(LParam);
????????????? ScreenToClient(FForm.Handle,p);
????????????? with BoundsRect do????????????????? //减去框架宽度
??????????????? if (p.x >= Left-4) and (p.x <= Right-4) then Result := 888;
??????????? end;
????????? end;
??????? WM_NCLBUTTONDOWN,WM_NCLBUTTONDBLCLK:
????????? begin
??????????? Result := CallWindowProc(FOldWndProc,LParam);
??????????? with TWMNCLButtonDown(message) do
????????????? if not HitButton(Point(XCursor,YCursor)) then Exit;
??????????? if WParam = 888 then
??????????? begin
????????????? FButtonDown := True;
????????????? Repaint;
????????????? SetCapture(FForm.Handle);
??????????? end;
????????? end;
??????? WM_NCRBUTTONDOWN,WM_NCRBUTTONDBLCLK:
????????? begin
??????????? if WParam = 888 then
??????????? begin
????????????? if Assigned(FPopup) then
????????????? begin
??????????????? p.x := FForm.Left + BoundsRect.Left;
??????????????? p.y := FForm.Top + BoundsRect.Bottom;
??????????????? FPopup.Popup(p.x,p.y);
????????????? end;
??????????? end
??????????? else
????????????? Result:=CallWindowProc(FOldWndProc,LParam);
????????? end;
??????? WM_NCLBUTTONUP,WM_LBUTTONUP :
????????? begin
??????????? if FButtonDown then
??????????? begin
????????????? FButtonDown := False;
????????????? RePaint;
????????????? ReleaseCapture;
????????????? if Assigned(FOnClick) then FOnClick(self);
??????????? end
??????????? else
????????????? Result:=CallWindowProc(FOldWndProc,LParam);
????????? end;
??????? else
????????? Result := CallWindowProc(FOldWndProc,LParam);
????? end;
??? end
??? else
????? Result := CallWindowProc(FOldWndProc,LParam);
? end;
end;

procedure TTitleBarButton.SetGlyph(const Value: TBitmap);
begin
? FGlyph.Assign(Value);
? SendMessage(FForm.Handle,WM_NCACTIVATE,0);
end;

procedure TTitleBarButton.SetRightMargin(const Value: Cardinal);
begin
? FRightMargin := Value;
? SendMessage(FForm.Handle,0);
end;

procedure TTitleBarButton.SetVisible(const Value: Boolean);
begin
? FVisible := Value;
? SendMessage(FForm.Handle,0);
end;

procedure TTitleBarButton.Notification(Component: TComponent;
? Operation: TOperation);
begin
? inherited;
? if (Operation = opRemove) and (Component = FPopup) then
??? FPopup := nil;
end;

function TTitleBarButton.GetBoundsRect: TRect;
var
? Rec: TRect;
? FrameThick: Integer; //窗体框架厚度
? BtnWidth,BtnHeight: Integer; //标题栏按钮的宽度和高度
begin
? GetWindowRect(FForm.Handle,Rec); //得到窗体边界矩形，相对于屏幕左上角
? with Result do
? begin
??? FrameThick := GetSystemMetrics(SM_CYFRAME);
??? Left := (Rec.Right - Rec.Left) - RightMargin - FrameThick;
??? Top := FrameThick;
??? if FForm.Borderstyle in [bsSizeToolWin,bsSizeable] then
??? begin
????? Dec(Left,2); Inc(Top,2);
??? end
??? else begin
????? Dec(Left); Inc(Top);
??? end;
??? if (FForm.Borderstyle in [bsSizeToolWin,bsToolWindow]) then
??? begin
????? BtnWidth := GetSystemMetrics(SM_CXSMSIZE) - 2;
????? BtnHeight := GetSystemMetrics(SM_CYSMSIZE) - 4;
??? end
??? else begin
????? BtnWidth := GetSystemMetrics(SM_CXSIZE) - 2;
????? BtnHeight := GetSystemMetrics(SM_CYSIZE) - 4;
??? end;
??? Right := Left + BtnWidth;
??? Bottom := Top + BtnHeight;
? end;
end;

procedure TTitleBarButton.Paint;
var
? GlyphRect: TRect;
begin
? if not FVisible then Exit;
? with TCanvas.Create do
? begin
??? try
????? Handle := GetWindowDC(FForm.Handle); //得到窗体DC，包括标题栏、菜单、滚动条等
????? Brush.Color := FColor;???????? //画Button凸起和按下时的外观
????? if FButtonDown then
??????? Pen.Color := clBtnHighlight
????? else
??????? Pen.Color := cl3DDkShadow;
????? Rectangle(BoundsRect);
????? with BoundsRect do
????? begin
??????? if FButtonDown then
????????? Pen.Color := cl3DDkShadow
??????? else
????????? Pen.Color := clBtnHighLight;
??????? MoveTo(Left,Bottom-2);
??????? LineTo(Left,Top);
??????? LineTo(Right-1,Top);
??????? Pen.Color := clGray;
??????? if FButtonDown then
??????? begin
????????? MoveTo(Left+1,Bottom-3);
????????? LineTo(Left+1,Top+1);
????????? LineTo(Right-2,Top+1);
??????? end
??????? else begin
????????? MoveTo(Left+1,Bottom-2);
????????? LineTo(Right-2,Top);
??????? end;
????? end;

????? if Assigned(Glyph) then????? //如果关联了图片，则画图片
????? begin
??????? GlyphRect := BoundsRect;
??????? GlyphRect.Right := GlyphRect.Right - 7;
??????? GlyphRect.Bottom := GlyphRect.Bottom - 5;
??????? if FButtonDown then
????????? OffsetRect(GlyphRect,4,3)
??????? else
????????? OffsetRect(GlyphRect,3,2);
??????? with GlyphRect do
????????? StretchBlt(Handle,Left,Top,Right-Left,Bottom-Top,
??????????? FGlyph.Canvas.Handle,FGlyph.Width,FGlyph.Height,srcCopy);
????? end;
??? finally
????? ReleaseDC(FForm.Handle,Handle);
????? Free;
??? end;
? end;
end;

procedure TTitleBarButton.Repaint;
begin
? Paint;
end;

end.