300分求改托盘控件(300分)

我有个托盘控件的源码，但是再程序最小化的时候不能再任务栏隐藏程序，请各位大虾帮我把这个代码改了，改为可以在程序最小化的时候实现在任务栏隐藏，其他的功能要求不变，谢谢！！！分不够再加！！！
另外不要告诉我什么获取消息什么的，我脑子都大了，就直接帮我把代码改了，然后给我一完整的代码吧，谢谢啦

{ TTrayIcon VCL. Version 1.3

Requires: Delphi 2.0 32 bit.

Function: Adds an icon to the Windows 95 Tool Tray and
has events to respond to mouse clicks.

This component is based on the TToolIcon VCL that was written by
Derek Stutsman (dereks@metronet.com). He based his component on
TWinControl, so it showed up as a clear, blank, resizable window at
design time and also had more properties than the component actually
needed. This made it really hard to find on a busy form sometimes.

I changed it so it would be based on TComponent so that it was readily
visible at design time and also did not cover anything at run-time.
The additional Top, left, width, etc. properties are also no longer
necessary. I added a ShowDesigning property so that you could test
it at design time, but then turn it off so that TWO icons weren't shown
on the tool tray when developing and testing.

One strange anomaly that I worked around but don't know why it happens -
if a ToolTip is not specified, then at run-time the icon shows up as
blank. If a ToolTip is specified, everything works fine. To fix this,
I set up another windows message that set the tool tip if it was blank -
this ensures proper operation at all times, but I don't know why this
is necessary. If you can figure it out, send me some mail and let me
know! (4/17/96 note - still no solution for this!)

This is freeware (as was the original). If you make cool changes to it,
please send them to me.

Enjoy!

Pete Ness
Compuserve ID: 102347,710
Internet: 102347.710@compuserve.com
http://ourworld.compuserve.com/homepages/peteness

Release history:

3/8/96 - Version 1.0
Release by Derek Stutsman of TToolIcon version 1.0

3/12/96 - Version 1.1

Changed as outlined above by me (Pete Ness) and renamed to TTrayIcon.

3/29/96 - Version 1.2
Add default window handling to allow closing when Win95 shutdown.
Previously, you had to manually close your application before closing
Windows 95.

4/17/96 - Version 1.3
Added a PopupMenu property to automatically handle right clicking on
the tray icon.
Fixed bug that would not allow you to instantiate a TTrayIcon instance
at run-time.
Added an example program to show how to do some of the things I've
gotten the most questions on.
This version is available from my super lame web page - see above for
the address.

7/24/96 - Version 1.?
Added a ShowApp and IDMessage property. TrayIcon apps mostly don't show
a button on the taskbar and can't start multiple times. If you set the
property ShowApp to 'true' there will be a button on the windows 95
taskbar else it won't. If IDMessage is empty, multiple instances can run
the same time, when you type an identification string you can run only
one instance. For the IDMessage property I've used a freeware (JustOne
v2.0) component from Eric Pankoke (epankoke@cencom.net)
I don't know if I've made a good job (doing it the right way), it's the
first time I change a component.

Don't mention my (bad) English, Dutch is my natural language. You can reach
me by e-mail at: ameeder@dds.nl, Alexander Meeder.

}



unit Trayicon;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, ShellAPI, Forms, menus;

const WM_TOOLTRAYICON = WM_USER+1;
WM_RESETTOOLTIP = WM_USER+2;

type

TTrayIcon = class(TComponent)

private

// BDS
{ internal use }

hMapping: THandle;

{ Field Variables }

IconData: TNOTIFYICONDATA;
fIcon : TIcon;
fToolTip : String;
fWindowHandle : HWND;
fActive : boolean;
fShowApp : boolean; // A. Meeder
fSendMsg : string;
fShowDesigning : Boolean;

{ Events }

fOnClick : TNotifyEvent;
fOnDblClick : TNotifyEvent;
fOnRightClick : TMouseEvent;
fPopupMenu : TPopupMenu;

function AddIcon : boolean;
function ModifyIcon : boolean;
function DeleteIcon : boolean;

procedure SetActive(Value : boolean);
procedure SetShowApp(Value : boolean); // A. Meeder
procedure SetShowDesigning(Value : boolean);
procedure SetIcon(Value : TIcon);
procedure SetToolTip(Value : String);
procedure WndProc(var msg : TMessage);

procedure FillDataStructure;
procedure DoRightClick( Sender : TObject );

protected

public
FMessageID: DWORD;

constructor create(aOwner : TComponent); override;
procedure Loaded; override; // A. Meeder
destructor destroy; override;
procedure GoToPreviousInstance;

published

property Active : boolean read fActive write SetActive;
property ShowDesigning : boolean read fShowDesigning write SetShowDesigning;
property Icon : TIcon read fIcon write SetIcon;
property IDMessage : string read fSendMsg write fSendMsg;
property ShowApp : boolean read fShowApp write SetShowApp; // A. Meeder
property ToolTip : string read fTooltip write SetToolTip;

property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
property OnRightClick : TMouseEvent read FOnRightClick write FonRightClick;
property PopupMenu : TPopupMenu read fPopupMenu write fPopupMenu;

end;

procedure Register;

type
PHWND = ^HWND;

implementation


procedure TTrayIcon.GoToPreviousInstance;
begin
PostMessage(hwnd_Broadcast, fMessageID, 0, 0);
end;

procedure TTrayIcon.SetActive(Value : boolean);
begin
if value <> fActive then begin
fActive := Value;
if not (csdesigning in ComponentState) then begin
if Value then begin
AddIcon;
end else begin
DeleteIcon;
end;
end;
end;
end;

procedure TTrayIcon.SetShowApp(Value : boolean); // A. Meeder
begin
if value <> fShowApp then fShowApp := value;
if not (csdesigning in ComponentState) then
begin
if Value then
begin
ShowWindow(Application.Handle, SW_SHOW);
end
else
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
end;
end;

procedure TTrayIcon.SetShowDesigning(Value : boolean);
begin
if csdesigning in ComponentState then begin
if value <> fShowDesigning then begin
fShowDesigning := Value;
if Value then begin
AddIcon;
end else begin
DeleteIcon;
end;
end;
end;
end;

procedure TTrayIcon.SetIcon(Value : Ticon);
begin
if Value <> fIcon then
begin
fIcon.Assign(value);
ModifyIcon;
end;
end;

procedure TTrayIcon.SetToolTip(Value : string);
begin

// This routine ALWAYS re-sets the field value and re-loads the
// icon. This is so the ToolTip can be set blank when the component
// is first loaded. If this is changed, the icon will be blank on
// the tray when no ToolTip is specified.

if length( Value ) > 62 then
Value := copy(Value,1,62);
fToolTip := value;
ModifyIcon;

end;

constructor TTrayIcon.create(aOwner : Tcomponent);
begin
inherited create(aOwner);
FWindowHandle := AllocateHWnd( WndProc );
FIcon := TIcon.Create;

SetShowApp(False);
end;

destructor TTrayIcon.destroy;
begin

// BDS
CloseHandle(hMapping);

if (not (csDesigning in ComponentState) and fActive)
or ((csDesigning in ComponentState) and fShowDesigning) then
DeleteIcon;

FIcon.Free;
DeAllocateHWnd( FWindowHandle );
inherited destroy;

end;

procedure TTrayIcon.Loaded; // A. Meeder
var
// BDS
// hMapping: HWND;
tmp, tmpID: PChar;
begin
inherited Loaded;
if fSendMsg <> '' then
begin
GetMem(tmp, Length(fSendMsg) + 1);
GetMem(tmpID, Length(fSendMsg) + 1);
StrPCopy(tmp, fSendMsg);
StrPCopy(tmpID, fSendMsg);
fMessageID := RegisterWindowMessage(tmp);
FreeMem(tmp);
hMapping := CreateFileMapping(HWND($FFFFFFFF), nil, PAGE_READONLY, 0, 32, tmpID);
if (hMapping <> 0) and (GetLastError = ERROR_ALREADY_EXISTS) then
begin
if not (csDesigning in ComponentState) then
begin
GotoPreviousInstance;
FreeMem(tmpID);
halt;
end;
end;
FreeMem(tmpID);
end;

SetShowApp(fShowApp);

end;

procedure TTrayIcon.FillDataStructure;
begin

with IconData do begin

cbSize := sizeof(TNOTIFYICONDATA);
wnd := FWindowHandle;
uID := 0; // is not passed in with message so make it 0
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
hIcon := fIcon.Handle;
StrPCopy(szTip,fToolTip);
uCallbackMessage := WM_TOOLTRAYICON;

end;

end;

function TTrayIcon.AddIcon : boolean;
begin
FillDataStructure;
result := Shell_NotifyIcon(NIM_ADD,@IconData);

// For some reason, if there is no tool tip set up, then the icon
// doesn't display. This fixes that.

if fToolTip = '' then
PostMessage( fWindowHandle, WM_RESETTOOLTIP,0,0 );

end;

function TTrayIcon.ModifyIcon : boolean;
begin

FillDataStructure;
if fActive then
result := Shell_NotifyIcon(NIM_MODIFY,@IconData)
else
result := True;

end;

procedure TTrayIcon.DoRightClick( Sender : TObject );
var MouseCo: Tpoint;
begin

GetCursorPos(MouseCo);

if assigned( fPopupMenu ) then begin
SetForegroundWindow( Application.Handle );
Application.ProcessMessages;
fPopupmenu.Popup( Mouseco.X, Mouseco.Y );
end;

if assigned( FOnRightClick ) then
begin
FOnRightClick(self,mbRight,[],MouseCo.x,MouseCo.y);
end;
end;

function TTrayIcon.DeleteIcon : boolean;
begin
result := Shell_NotifyIcon(NIM_DELETE,@IconData);
end;

procedure TTrayIcon.WndProc(var msg : TMessage);
begin
with msg do
if (msg = WM_RESETTOOLTIP) then
SetToolTip( fToolTip )
else if (msg = WM_TOOLTRAYICON) then begin
case lParam of
WM_LBUTTONDBLCLK : if assigned (FOnDblClick) then FOnDblClick(self);
WM_LBUTTONUP : if assigned(FOnClick)then FOnClick(self);
WM_RBUTTONUP : DoRightClick(self);
end;
end
else // Handle all messages with the default handler
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);

end;

procedure Register;
begin
RegisterComponents('Win95', [TTrayIcon]);
end;

end.

不要用什么控件嘛，直接写好了。 http://www.2ccc.com/article.asp?articleid=942

如果是想解决 实际 问题的 还有很多优秀的控件 可以用 ，
如果只是想研究此问题 ，等我明天有时间看一下。。 ：）

应用程序不显示在任务栏
SetWindowLong(Application.handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);

http://www.2ccc.com/article.asp?articleid=34
http://downloads.2ccc.com/vcl/bars/trayicon.zip
CoolTrayIcon v.4.3.1 任务栏图标

不是要解决实际问题，解决实际问题确实有很多办法，现在就是想要这么一个控件，但是CoolTrayIcon 又太复杂了

其实现在最主要的就是我不能获取最小化的消息

http://www.delphibbs.com/delphibbs/dispq.asp?lid=620554

能告诉我怎么再这段程序中添加捕捉窗体最小化么的消息么，谢谢~~~~~~~~~~~~~~~~

是不是应该 程序自己 扑捉 到消息 然后操作托盘 ？
难道要把 扑捉 程序消息 的任务交给 托盘控件？

这个。。。。。。
我这还有段托盘控件的代码，就可以在点最小化按钮的时候把程序从任务栏中隐藏，但是这个代码功能又太少了，我试着把两个整合过，可是一直没成功

你帮我看看下面这个代码，能不能和一楼的代码整合，这个就可以实现在点最小化按钮的时候把程序从任务栏中隐藏


unit ZhangChuYi;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShellApi;

type
TZhangChuYi = class(TComponent)
private
ZForm:TForm;
ZHint:String;
ZIsSetHook:Boolean;
ZMainFormInstanceointer;
ZMainFormWndProcointer;
ZTrayData:TNotifyIconData;
ZTrayIconCreated:Boolean;
Procedure AddTrayIcon; //加载TrayIcon
Procedure MainFormWndProc(Var Message:TMessage);
Procedure RemoveTrayIcon; //去处TrayIcon
Procedure SetHint(const Value:String); //设置Hint
Procedure UnhookMainForm;
protected
Procedure Loaded;override;
public
Constructor Create(AOwner:TComponent);override;
Destructor Destroy;override;
published
Property Hint:String read ZHint write SetHint; //Hint属性
end;

procedure Register;

implementation

const
TrayID=1;
CM_TRAYICON=WM_USER+1;

Constructor TZhangChuYi.Create(AOwner:TComponent);
Begin
Inherited; //继承父类
End;

{---------------------------------------------------------}

Destructor TZhangChuYi.Destroy;
Begin
Inherited; //继承父类
End;

//加载TrayIcon
Procedure TZhangChuYi.AddTrayIcon;
Var
AHint:String;
Begin
ZTrayData.cbSize:=SizeOf(ZTrayData);
ZTrayData.Wnd:=ZForm.Handle;
ZTrayData.uID:=TrayID;
ZTrayData.uFlags:=NIF_ICON Or NIF_MESSAGE Or NIF_TIP;
ZTrayData.uCallBackMessage:=CM_TRAYICON;
ZTrayData.hIcon:=ZForm.Icon.Handle;
If ZTrayData.hIcon=0 Then
ZTrayData.hIcon:=Application.Icon.Handle;
AHint:=ZHint;
If AHint='' Then
AHint:=ZForm.Caption;
StrLCopy(ZTrayData.szTip,PChar(AHint),SizeOf(ZTrayData.szTip)-1);
Shell_NotifyIcon(NIM_ADD,@ZTrayData);
ZTrayIconCreated:=True;
End;

{---------------------------------------------------------}

Procedure TZhangChuYi.Loaded;
Begin
Inherited;
If Not (csDesigning In ComponentState) And (Owner Is TForm) And
((Application.MainForm=Nil) Or (Owner=Application.MainForm)) Then
Begin
ZForm:=Owner As TForm;
ZMainFormInstance:=MakeObjectInstance(MainFormWndProc);
ZMainFormWndProc:=Pointer(SetWindowLong(ZForm.Handle,GWL_WNDPROC,Integer(ZMainFormInstance)));
ZIsSetHook:=True;
End;
End;

{---------------------------------------------------------}

Procedure TZhangChuYi.MainFormWndProc(Var Message:TMessage);
Var
IsCallWndProc:Boolean;
Begin
IsCallWndProc:=True;
Case Message.Msg Of
WM_SYSCOMMAND:
Case Message.wParam Of
SC_MINIMIZE:
Begin
ShowWindow(ZForm.Handle,SW_HIDE);
ShowWindow(Application.Handle,SW_HIDE);
AddTrayIcon;
IsCallWndProc:=False;
End;
End;
WM_DESTROY:
Begin
RemoveTrayIcon;
UnhookMainForm;
End;
CM_TRAYICON:
Begin
Case Message.lParam Of
WM_LBUTTONDBLCLK:
Begin
RemoveTrayIcon;
ShowWindow(Application.Handle,SW_SHOW);
ShowWindow(ZForm.Handle,SW_SHOW);
End;
End;
End;
End;
If IsCallWndProc Then
With Message Do
Result:=CallWindowProc(ZMainFormWndProc,Application.MainForm.Handle,Msg,wParam,lParam);
End;

{---------------------------------------------------------}

Procedure TZhangChuYi.RemoveTrayIcon;
Begin
If ZTrayIconCreated Then
Begin
Shell_NotifyIcon(NIM_DELETE,@ZTrayData); //释放程序，以免占用系统资源
ZTrayIconCreated:=False;
End;
End;

//设置Hint
Procedure TZhangChuYi.SetHint(const Value:String);
Var
Data:TNotifyIconData;
Begin
If ZHint=Value Then
Exit;
ZHint:=Value;
If ZTrayIconCreated Then
Begin
Data:=ZTrayData;
Data.uFlags:=NIF_TIP;
StrLCopy(Data.szTip,PChar(ZHint),SizeOf(Data.szTip)-1);
Shell_NotifyIcon(NIM_MODIFY,@Data);
End;
End;


Procedure TZhangChuYi.UnhookMainForm;
Begin
If ZIsSetHook Then
Begin
SetWindowLong(Application.MainForm.Handle,GWL_WNDPROC,Integer(ZMainFormWndProc));
End;
End;

//注册组件
procedure Register;
begin
RegisterComponents('ZhangChuYi', [TZhangChuYi]);
end;

end.

顶一下

先吃饭 等下 试试

好的，谢谢啦

我觉得关键的代码是这两部分：

Procedure TZhangChuYi.Loaded;
Begin
Inherited;
If Not (csDesigning In ComponentState) And (Owner Is TForm) And
((Application.MainForm=Nil) Or (Owner=Application.MainForm)) Then
Begin
ZForm:=Owner As TForm;
ZMainFormInstance:=MakeObjectInstance(MainFormWndProc);
ZMainFormWndProc:=Pointer(SetWindowLong(ZForm.Handle,GWL_WNDPROC,Integer(ZMainFormInstance)));
ZIsSetHook:=True;
End;
End;

{---------------------------------------------------------}

Procedure TZhangChuYi.MainFormWndProc(Var Message:TMessage);
Var
IsCallWndProc:Boolean;
Begin
IsCallWndProc:=True;
Case Message.Msg Of
WM_SYSCOMMAND:
Case Message.wParam Of
SC_MINIMIZE:
Begin
ShowWindow(ZForm.Handle,SW_HIDE);
ShowWindow(Application.Handle,SW_HIDE);
AddTrayIcon;
IsCallWndProc:=False;
End;
End;
WM_DESTROY:
Begin
RemoveTrayIcon;
UnhookMainForm;
End;
CM_TRAYICON:
Begin
Case Message.lParam Of
WM_LBUTTONDBLCLK:
Begin
RemoveTrayIcon;
ShowWindow(Application.Handle,SW_SHOW);
ShowWindow(ZForm.Handle,SW_SHOW);
End;
End;
End;
End;
If IsCallWndProc Then
With Message Do
Result:=CallWindowProc(ZMainFormWndProc,Application.MainForm.Handle,Msg,wParam,lParam);
End;

这里面那个Loaded中的那个调用没看明白是怎么回事

闲的没事我就顶

为什么说我不要关税呢

TCollTrayIcon其实一点都不复杂。
它里边的定时器/文字图标等都是额外的东西,核心只有15xx行,可是注释以及Begin/end等占了很多,而核心的东西,精简一下,没有多少.不外乎一个消息处理.
推荐给你是因为
if (使用) then
theBenefit := easeToUse
else if (研究) then
theBenefit := notComplex
else ;
比如你所说的得到窗体最小化消息
constructor TCoolTrayIcon.Create(AOwner: TComponent);
begin
...
if Owner is TWinControl then
HookForm;
end;
你所说的TZhangChuYi至少在消息处理方面和TCollTrayIcon很像,代码很类似.
TCollTrayIcon也有 TCoolTrayIcon.Loaded/TCoolTrayIcon.HookFormProc

我下一个看看吧，我记得playicq有
要是我用的话其实直接写程序里面比再写个控件省事
可事这个是我一个朋友，学信息管理的作业，从网上找一个吧，深了不是潜了不是的
哎

真不知道分怎么分了
刘先生为了我这个问题费时费力
zjan521虽说说的话少，但是最后那个贴子直接导致了我的成功
一半一半吧
两位要是觉得少我可以在单开贴子，再各放150分
谢谢两位了~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~