在任务栏创建一个跟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.


...全文
258 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
hjkto 2009-11-06
  • 打赏
  • 举报
回复
mark
大肚肥肥 2009-11-05
  • 打赏
  • 举报
回复
呼唤高手。。。
大肚肥肥 2009-11-04
  • 打赏
  • 举报
回复
不该使用 SetWindowPos 函数?

我感觉是 窗体样式的选择 不对。 有类似于delphi alLeft 的样式么?
gyk120 2009-11-04
  • 打赏
  • 举报
回复
应该是SetWindowPos的问题吧
大肚肥肥 2009-11-04
  • 打赏
  • 举报
回复
是开始菜单的任务栏,非IE。

1,184

社区成员

发帖
与我相关
我的任务
社区描述
Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧