www.pudn.com > whocq2src.zip > TBottom.pas

unit main; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes,  
Graphics, Controls, Forms, Dialogs, 
  StdCtrls, Menus; 
 
type 
  TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
 
  private 
    { Private declarations } 
 
    TBRect: TRect;   // Caption Bar Button Rectangle 
    CBBtnFont: TFont;   // Caption Bar Button Font 
    procedure DrawCaptionBtn(uEdge: UINT); 
    // 当在标题栏上按下鼠标左按钮时进入该过程 
procedure WMNcLButtonDown(var m: TMessage);  
message WM_NCLBUTTONDOWN; 
    // 当在标题栏上放开鼠标左按钮时进入该过程 
procedure WMNcLButtonUp(var m: TMessage);  
message WM_NCLBUTTONUP; 
    // 当在标题栏上移动鼠标时进入该过程 
procedure WMNcMouseMove(var m: TMessage);  
message WM_NCMOUSEMOVE; 
    // 当在标题栏上双击鼠标左铵钮时进入该过程 
procedure WMNcLButtonDBLClk 
(var m: TMessage); message WM_NCLBUTTONDBLCLK; 
    // 当在标题栏上按下鼠标右按钮时进入该过程 
procedure WMNcRButtonDown(var m: TMessage);  
message WM_NCRBUTTONDOWN; 
    // 当画标题栏时进入该过程 
procedure WMNcPaint(var m: TMessage);  
message WM_NCPAINT; 
    // 当标题栏在激活与非激活之间切换时进入该过程 
procedure WMNcActivate(var m: TMessage);  
message WM_NCACTIVATE; 
  public 
    { Public declarations } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
procedure TForm1.DrawCaptionBtn(uEdge: UINT); 
var 
   hCaptionDC: HDC; // 标题条Device Context 
   hOldFont: HFONT; // 原来的字体 
   r: TRect; 
begin 
     hCaptionDC := GetWindowDC(Self.Handle); 
 // 注意不能用GetDC,那样的话，将得不到标题栏 
 // 的设备上下文 
     //画按钮的样子，如果uEdge=EDGE_RAIS， 
则画出的样子为凸起；如果 
//uEdge=EDGE_SUNKEN，则画出的样子为凹下。 
     DrawEdge(hCaptionDC, TBRect, uEdge,  
BF_RECT or BF_MIDDLE or 
            BF_SOFT);  
 
     //设置标题栏的设备上下文为透明状态 
     SetBkMode(hCaptionDC, TRANSPARENT); 
 
     //设置标题栏设备上下文的字体 
     hOldFont:= SelectObject(hCaptionDC, CBBtnFont.Handle); 
 
     //画按钮 
     if uEdge = EDGE_RAISED then 
        DrawText(hCaptionDC, 'Caption Bar Button',  
18, TBRect, DT_CENTER) 
     else begin 
        r := TBRect; 
        OffsetRect(r, 1, 1);  
        DrawText(hCaptionDC, 'Caption Bar Button', 18, r, DT_CENTER); 
     end; 
 
     //还原为原来的字体 
     SelectObject(hCaptionDC, hOldFont); 
end; 
 
procedure TForm1.WMNcActivate(var m: TMessage); 
begin 
     inherited; 
     DrawCaptionBtn(EDGE_RAISED); 
end; 
 
 
procedure TForm1.WMNcPaint(var m: TMessage); 
begin 
     inherited; 
     DrawCaptionBtn(EDGE_RAISED); 
end; 
 
 
procedure TForm1.WMNcLButtonDBLClk(var m: TMessage); 
var 
   p: TPoint; 
begin 
     p.x := LOWORD(m.lParam) - Self.Left; 
     p.y := HIWORD(m.lParam) - Self.Top; 
     if not PtInRect(TBRect, p) then // 如果不在按钮区域内 
        inherited;  // 执行默认的操作 
end; 
 
procedure TForm1.WMNcMouseMove(var m: TMessage); 
var 
   p: TPoint; 
begin 
     p.x := LOWORD(m.lParam) - Self.Left; 
     p.y := HIWORD(m.lParam) - Self.Top; 
     if not PtInRect(TBRect, p) then // 如果不在按钮区域 
        DrawCaptionBtn(EDGE_RAISED) 
     else 
        inherited; // 执行默认的操作 
end; 
 
 
procedure TForm1.WMNcLButtonDown(var m: TMessage); 
var 
   p: TPoint; 
begin 
     p.x := LOWORD(m.lParam) - Self.Left; 
     p.y := HIWORD(m.lParam) - Self.Top; 
     if PtInRect(TBRect, p) then  // 如果按在了按钮区域 
     begin 
        Self.BringToFront; 
        DrawCaptionBtn(EDGE_SUNKEN); 
     end 
     else 
        inherited; // 执行默认的操作 
end; 
 
 
procedure TForm1.WMNcLButtonUp(var m: TMessage); 
var 
   p: TPoint; 
begin 
     p.x := LOWORD(m.lParam) - Self.Left; 
     p.y := HIWORD(m.lParam) - Self.Top; 
     if PtInRect(TBRect, p) then //  
如果在标题栏按钮区域释放鼠标 
     begin 
        DrawCaptionBtn(EDGE_RAISED); 
     end 
     else 
        inherited; // 执行默认的操作 
end; 
 
 
procedure TForm1.WMNcRButtonDown(var m: TMessage); 
var 
   p: TPoint; 
begin 
     p.x := LOWORD(m.lParam) - Self.Left; 
     p.y := HIWORD(m.lParam) - Self.Top; 
     if not PtInRect(TBRect, p) then // 如果不在标题栏按钮区域 
        inherited;  // 执行默认的操作 
end; 
 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
     // 这个大小大家可以得用GetSystemMetrics 
函数来进行更精确的计算。这里 
     // 只是用来示例 
     with TBRect do 
     begin 
          left := 100; 
          top  := 6; 
          right := 450; 
          bottom := 20; 
     end; 
 
     // 标题栏按钮字体。 
     CBBtnFont:= TFont.Create; 
     with CBBtnFont do 
     begin 
          Name := '宋体'; 
          Size := 9; 
          Color := clRed; 
     end; 
end; 
 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
     CBBtnFont.Free; 
end; 
 
end.