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, 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.