我给你一个我写的例程,包你满意。
//*******************************************************//
//soft name: 'Soft CDRom Switch',
//author: ywf,
//time: 2002.3.14.night,
//last modify: 2002.3.30.
//*******************************************************//
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellApi,
Menus, MMsystem, Registry;
type
TMainFrm = class(TForm)
LeftPop: TPopupMenu;
Eject: TMenuItem;
CloseCd: TMenuItem;
RightPop: TPopupMenu;
EnabledOrNo: TMenuItem;
ExitPro: TMenuItem;
About: TMenuItem;
Cancel1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure EjectClick(Sender: TObject);
procedure CloseCdClick(Sender: TObject);
procedure ExitProClick(Sender: TObject);
procedure EnabledOrNoClick(Sender: TObject);
procedure AboutClick(Sender: TObject);
procedure Cancel1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
IconData: TNotifyIconData;
useOrNo: Boolean;
procedure InstallIcon;
procedure UnInstallIcon;
Procedure UnEnabledIcon( Yes: boolean);
//respond the Message on the "CurrentIcon".
procedure OnIconclick( Var Message: TMessage);
Message WM_User+1;
public
{ Public declarations }
end;
var
MainFrm: TMainFrm;
implementation
uses AboutUnit;
{$R *.DFM}
{$R MyIcon.Res}
{ TMainFrm }
procedure TMainFrm.InstallIcon;
begin
IconData.hIcon:= LoadIcon(HInstance, 'Rose');
IconData.szTip:= 'Soft CDRom Switch 欢迎您!';
Shell_NotifyIcon(NIM_Add, @IconData);
//Mark the status of Icon for the popMenu operation.
UseOrNo:= True;
end;
procedure TMainFrm.UnInstallIcon;
begin
Shell_NotifyIcon( NIM_Delete, @IconData);
end;
procedure TMainFrm.UnEnabledIcon(Yes: Boolean);
begin
if Yes then
//install a UnEnabled Icon.
begin
IconData.hIcon := LoadIcon(hInstance, 'Rose');
end
else
//Install a enabled Icon.
begin
IconData.hIcon := LoadIcon(hInstance, 'ERose');
end;
UseOrNo:= Not UseOrNo;
Shell_NotifyIcon( NIM_Modify, @IconData);
end;
procedure TMainFrm.FormCreate(Sender: TObject);
var
Reg: TRegistry;
AppName: Pchar;
begin
//Set the program auto run when the window running.
Reg:= TRegistry.Create;
AppName:= Pchar(Application.ExeName);
try
Reg.RootKey:= Hkey_Local_Machine;
if Reg.OpenKey('SoftWare/Microsoft/Windows/CurrentVersion/Run', False) then
//add data to registry.
Reg.WriteString('RunSoftCDRomSwitch', AppName)
else
Application.MessageBox('open registry failed!','Warning', Mb_IconInformation+Mb_Ok);
finally
Reg.CloseKey;
Reg.Free;
end;
//Registry operation end.
IconData.cbSize:= SizeOf( IconData);
IconData.Wnd:= handle;
IconData.uFlags:= NIF_Message or NIF_Tip or NIF_Icon;
IconData.uID:= 1;
IconData.uCallbackMessage:= WM_User+1;
//Install Icon;
InstallIcon;
//hide Mainfrm;
SetWindowLong( Application.Handle, GWL_ExStyle, WS_EX_ToolWindow);
ShowWindow( MainFrm.Handle, SW_Hide);
end;
procedure TMainFrm.OnIconclick(var Message: TMessage);
var
Position: TPoint;
begin
GetCursorPos( Position);
if message.LParam= WM_LButtonDown then
begin
LeftPop.Popup( Position.x, Position.y);
end;
if Message.LParam= WM_RButtonDown then
begin
RightPop.Popup( Position.x, Position.y);
// exit;
end;
end;
procedure TMainFrm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
UnInstallIcon;
end;
procedure TMainFrm.FormActivate(Sender: TObject);
begin
//hide MainFrm.
Height:= 0;
Width:= 0;
ShowWindow(Handle, SW_Hide);
end;
procedure TMainFrm.EjectClick(Sender: TObject);
begin
MciSendString('Set CdAudiodo
or open wait', nil, 0, handle);
end;
procedure TMainFrm.CloseCdClick(Sender: TObject);
begin
MciSendString('Set CdAudiodo
or closed wait', nil , 0, handle);
end;
procedure TMainFrm.ExitProClick(Sender: TObject);
begin
MainFrm.Close;
end;
procedure TMainFrm.EnabledOrNoClick(Sender: TObject);
begin
if UseOrNo then
begin
UnEnabledIcon(False);
Eject.Enabled:= False;
CloseCd.Enabled:= False;
EnabledOrNo.Caption:= 'Enabled Program';
end
else
begin
UnEnabledIcon(True);
Eject.Enabled:= True;
CloseCd.Enabled:= True;
EnabledOrNo.Caption:= 'UnEnalbed Program';
end;
end;
procedure TMainFrm.AboutClick(Sender: TObject);
begin
AboutFrm:= TAboutFrm.Create(Self);
AboutFrm.ShowModal;
end;
procedure TMainFrm.Cancel1Click(Sender: TObject);
begin
exit;
end;
procedure TMainFrm.FormShow(Sender: TObject);
begin
ShowWindow(handle, SW_Hide);
end;
end.
//*****************************************************
//about窗体,你可以不要
//*****************************************************
unit AboutUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TAboutFrm = class(TForm)
Bevel1: TBevel;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormDblClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AboutFrm: TAboutFrm;
implementation
{$R *.DFM}
procedure TAboutFrm.FormDblClick(Sender: TObject);
begin
close
end;
procedure TAboutFrm.FormShow(Sender: TObject);
begin
EnableMenuItem(GetSystemMenu(Handle, FALSE), SC_CLOSE, MF_BYCOMMAND or MF_GRAYED);
end;
end.
//注意图标我用资源文件封装起来了,你可以把{$R MyIcon.Res}注掉。