unit1.pas

Delphi7应用编程150例附书源码.rar

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    ButtonRect: TRect;
    //工具栏上按钮的区域
    procedure DrawCaptionBtn(BtnStyle: 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(BtnStyle: UINT);
var
   hCaptionDC: HDC;
   //标题条的设备上下文
   r: TRect;
begin
     hCaptionDC := GetWindowDC(Self.Handle);
     //注意不能用GetDC,那样的话，将得不到标题栏的设备上下文
     DrawEdge(hCaptionDC, ButtonRect, BtnStyle,BF_RECT or BF_MIDDLE or BF_SOFT);
     //画按钮的样子，如果BtnStyle=EDGE_RAISED，则画出的样子为凸起；
     //如果BtnStyle=EDGE_SUNKEN，则画出的样子为凹下

     SetBkMode(hCaptionDC, TRANSPARENT);
     //设置标题栏的设备上下文为透明状态

     if BtnStyle = EDGE_RAISED then
        DrawText(hCaptionDC, '按钮',4, ButtonRect, DT_CENTER)
     else
     begin
        r := ButtonRect;
        OffsetRect(r, 1, 1);
        DrawText(hCaptionDC, '按下',4, r, DT_CENTER);
     end;
     //画按钮
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(ButtonRect, 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(ButtonRect, 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(ButtonRect, p) then
     // 如果按在了按钮区域
     begin
        Self.BringToFront;
        DrawCaptionBtn(EDGE_SUNKEN);
        ShowMessage('按下了按钮');
     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(ButtonRect, 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(ButtonRect, p) then
        inherited;
        //如果不在标题栏按钮区域,执行默认的操作
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     with ButtonRect do
     begin
          left := 100;
          top  := 4;
          right := 150;
          bottom := 22;
     end;
end;

end.