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.
總結
以上是生活随笔為你收集整理的Delphi组件开发-在窗体标题栏添加按钮的全部內容,希望文章能夠幫你解決所遇到的問題。
- 上一篇: 我也想对广大程序员说一些话
- 下一篇: 统一归档助企业撑起信息的保护伞