在任务栏创建一个跟google 快速搜索类似的按钮？

大肚肥肥 2009-11-04 05:10:42

如题，找到以前的一篇老贴，http://topic.csdn.net/t/20030114/18/1358329.html
我现在能创建，但是按钮位置始终不能正常排序。

代码贴上，望高手指点一二



unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls;



type

  TForm1 = class(TForm)

    btnNew: TButton;

    btnRestore: TButton;

    procedure FormCreate(Sender: TObject);

    procedure btnNewClick(Sender: TObject);

    procedure btnRestoreClick(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  private

          {   Private   declarations   }

    FNewButton: Boolean; //   Check   whether   new   start   button   had   been   created.

    procedure NewButtonMsg(var Msg: TMessage); //   new   button   events.

  public

          {   Public   declarations   }

  end;



var

  Form1: TForm1;

  OldProc, NewProc: Pointer;

  StartBtnHwnd, TrayHwnd, ReplaceBtnHwnd: Hwnd;



implementation



{$R   *.DFM}



function ButtonWndProc(CtlHandle: Hwnd; uMsg: Uint; AWParam: Wparam; ALparam: Lparam): HResult; stdcall;

var

  Rct: TRect;

  pt: TPoint;

begin

  if uMsg = WM_LBUTTONUP then

  begin

    GetCursorPos(pt);

    GetClientRect(CtlHandle, Rct);

    MapWindowPoints(0, ctlHandle, pt, 1);

    if PtInRect(Rct, pt) then

      Showmessage('You   had   clicked   the   new   button   !')

  end;

  Result := CallWindowProc(OldProc, CtlHandle, uMsg, AWParam, ALParam);

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

  TrayHwnd := FindWindow('Shell_TrayWnd', nil);

  StartBtnHwnd := FindWindowEx(TrayHwnd, 0, 'Button', nil);

end;



procedure TForm1.btnNewClick(Sender: TObject);

var

  Rct: TRect;

  fnt: HFont;

begin

  if FNewButton then Exit;

  Windows.GetWindowRect(StartBtnHwnd, Rct);

  ReplaceBtnHwnd := CreateWindowEx(WS_EX_WINDOWEDGE,

    'Button', 'btnStartButton', WS_Child or WS_Visible,

    100, 1, rct.right - rct.left, Rct.bottom - Rct.top, TrayHwnd, 0, 0, nil); //   Create   a   button,   which   parent   is   windows's   Tray.

  if ReplaceBtnHwnd > 0 then

  begin                        //HWND_TOPMOST



    SetWindowPos(StartBtnHwnd, HWND_TOPMOST, Rct.left+100, rct.top, rct.right - rct.left, Rct.bottom - Rct.top, SWP_HIDEWINDOW {OR   SWP_NOREDRAW}); //   Hide   old   Start   button.



    SetWindowText(ReplaceBtnHwnd, '开始2'); //   Set   New   button's   font   and   caption.

    fnt := CreateFont(0, 0, 0, 0, FW_NORMAL, 0, 0, 0, ANSI_CHARSET, 0, 0, 0, 0, 'Time   New   Romans');

    SendMessage(ReplaceBtnHwnd, WM_SETFONT, fnt, MAKELPARAM(0, 0));





                                       //   Show   New   start   button.

    SetWindowPos(ReplaceBtnHwnd, HWND_TOPMOST, Rct.left, rct.top, rct.right - rct.left, Rct.bottom - Rct.top,

      SWP_SHOWWINDOW);

    ShowWindow(ReplaceBtnHwnd, SW_ShowNormal);

    UpdateWindow(ReplaceBtnHwnd);

          //   To   handle   the   new   messages.

    NewProc := Pointer(LongInt(MakeObjectInstance(NewButtonMsg)));

    OldProc := Pointer(SetWindowLong(ReplaceBtnHwnd, GWL_WNDPROC, LongInt(NewProc)));

    if NewProc = nil then

    begin

      Showmessage('Can   not   grab   new   button''s   message!');

      Exit;

    end;

    FNewButton := True;

  end;



end;



procedure TForm1.btnRestoreClick(Sender: TObject);

begin

  if FNewButton then //   Restore   Old   Start   button.

  begin

    SetWindowLong(ReplaceBtnHwnd, GWL_WNDPROC, LongInt(OldProc));

    DestroyWindow(ReplaceBtnHwnd);

    ReplaceBtnHwnd := 0;

    ShowWindow(StartBtnHwnd, SW_ShowNormal);

    SetWindowPos(StartBtnHwnd, HWND_TOPMOST, 0, 0, 50, 30, SWP_SHOWWINDOW);

    FNewButton := False;

  end;

end;



procedure TForm1.NewButtonMsg(var Msg: TMessage);

begin

  if Msg.Msg = WM_LBUTTONUP then

    showMessage('You   had   click   the   new   start   button')

  else

    Msg.Result := CallWindowProc(OldProc, ReplaceBtnHwnd, Msg.msg, msg.wParam, msg.lParam);

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  if FNewButton then

    btnRestoreClick(self); //   Restore   button   when   form   exiting.



end;



end.