从实作标题栏按钮开始浅谈组件的制作

开发组件的过程，其实就是从某一对象派生出一个新的对象，并且为该对象声明新的属性、方法和事件。下面我将通过制作一个标题栏按钮来讲述如何制作组件。

标题栏按钮组件TTitleBarButton以TComponent为直接继承对象，它是一个可以在窗体标题栏上显示按钮的组件，像最大化、最小化和关闭按钮等。最新的Winamp MP3播放器，它有一个插件可以在任何窗体上显示一排播放按钮，我想通过下面的技术也可以实现。

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事件代码。

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

实现标题栏按钮需要解决以下主要问题：

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 66;

property Visible: Boolean read FVisible write SetVisible default False;

property OnClick: TNotifyEvent read FOnClick write FOnClick;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Liao', [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 := 66;

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, GWL_WNDPROC, 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,FForm.Handle,Msg,WParam,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,FForm.Handle,Msg,WParam,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,FForm.Handle,Msg,WParam,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,FForm.Handle,Msg,WParam,LParam);

end;

else

Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

end;

end

else

Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

end;

end;

procedure TTitleBarButton.SetGlyph(const Value: TBitmap);

begin

FGlyph.Assign(Value);

SendMessage(FForm.Handle,WM_NCACTIVATE,0,0);

end;

procedure TTitleBarButton.SetRightMargin(const Value: Cardinal);

begin

FRightMargin := Value;

SendMessage(FForm.Handle,WM_NCACTIVATE,0,0);

end;

procedure TTitleBarButton.SetVisible(const Value: Boolean);

begin

FVisible := Value;

SendMessage(FForm.Handle,WM_NCACTIVATE,0,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,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, 0, 0, FGlyph.Width, FGlyph.Height, srcCopy);

end;

finally

ReleaseDC(FForm.Handle,Handle);

Free;

end;

end;

end;

procedure TTitleBarButton.Repaint;

begin

Paint;

end;

end.

另外，还可以对这个组件进一步扩展，扩展其它任一窗体，只要知道了窗体的Handle就行了。