我想实现在系统兰里面显示程序的图标给怎样做?(就像qq那样)分数可以再补(100分)

  • 主题发起人 主题发起人 kevin8093
  • 开始时间 开始时间
你不会找点以前的帖子吗?
这样的帖子太多!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
向大家求救了,我很急呀,希望大家帮个忙
 
procedure WMSYSCOMMAND(var Msg:TMessage);message WM_SYSCOMMAND;
procedure TForm1.WMSYSCOMMAND(var Msg:TMessage);
begin
case Loword(Msg.WParam) of
IDM_SYS_ABOUT:aboutbox.showmodal;
end;
Msg.Result:=1;
inherited;
end;
{procedure TForm1.NotifyIcon (var TM : TMessage);
var
AC : LongInt;
CP : TPoint;
begin
AC:=TM.LParam;
if AC=WM_LBUTTONDBLCLK then
begin
Form1.Show;
end;
if AC=WM_RBUTTONDOWN then
begin
GetCursorPos (CP);
PopupMenu2.Popup (CP.X, CP.Y);
end;
end;}

{procedure TForm1.AddTrayIcon(ID : integer; Hint : string; Icon : TIcon; hWnd : LongInt; CallBack : LongInt);
var
MC : TNotifyIconData;
begin
with MC do
begin
cbSize := sizeof(TNotifyIconData);
Wnd := hWnd;
uID := ID;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
uCallbackMessage := CallBack;
hIcon := Icon.Handle;
if (length(hint)>0) then
StrLCopy(szTip, PChar(hint), 63)
else
szTip[0] := #0;
end;
if Shell_NotifyIcon (NIM_ADD, @MC) then
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_DLGFRAME and not WS_EX_APPWINDOW);
end;

procedure TForm1.DestroyTrayIcon (ID : integer; hWnd : LongInt);
var
MC : TNotifyIconData;
begin
with MC do
begin
cbSize := sizeof(TNotifyIconData);
Wnd := hWnd;
uID := ID;
end;
Shell_NotifyIcon (NIM_DELETE, @MC);
end;
 
我来迟了,分数让张教主拿了!
 
Rx控件包有现成的控件。
 
有现成控件,留下Mail我发给你!
 
我的mail是kevin8093@eyou.com,谢了收到即给分
 
我上面写的很清楚了呀,你只要从
使用如下:
DestroyTrayIcon (1,Form1.Handle);
稍做修改就可以用了
 
随便找吧,托盘图标,呵呵,应该会改的了
 
用Rxlib控件包中的控件比较好用,还可以用动画图标!强烈建议使用,效果可以参考我写的两个软件:
1、网聊 - NetChat:http://1000f.com/download/netchat/NC61setup.exe
2、Sonic Player 4:http://1000f.com/download/Sonic/Sonic4.exe
 
给你个例子,建两个窗口,unit1.pas unit2.pas,找两个图标文件normal.ico,disable.ico
放在同一目录下:

unit1.pas
-------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, shellapi; //添加shellapi单元

const
ICON_ID = 1; //为图标和消息定义两个常量
MI_ICONEVENT = WM_USER+1;

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Appitem: TMenuItem;
EnableOrDisable: TMenuItem;
ExitItem: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure AppitemClick(Sender: TObject);
procedure EnableOrDisableClick(Sender: TObject);
procedure ExitItemClick(Sender: TObject);
private
{ Private declarations }
NormalIcon, DisabledIcon:TIcon;
Status:Boolean; //标识"允许使用"还是"禁止使用"
procedure InstallIcon;
procedure ChangeIcon(s:Boolean);
procedure UnInstallIcon;
procedure IconOnClick(var message: TMessage); message MI_ICONEVENT;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses unit2; //引用窗体2
{$R *.dfm}

procedure TForm1.ChangeIcon(s: Boolean);
var
IconData: TNotifyIconData;
begin
IconData.cbSize := SizeOf(IconData);
IconData.Wnd := Handle;
IconData.uID := ICON_ID;
if s=False then // 禁止使用
begin
IconData.hIcon := DisabledIcon.Handle;
Status := False;
AppItem.Enabled := False ;
end
else // 允许使用
begin
IconData.hIcon := Normalicon.handle;
status := true;
AppItem.Enabled := True;
end;
IconData.uFlags := NIF_ICON;
shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

procedure TForm1.IconOnClick(var message: TMessage);
var
p : Tpoint;
begin
// 如果按下的是鼠标左键,并且允许显示,则显示form2
if ( (message.lParam = WM_LBUTTONDOWN) and (Status=True) ) then
Form2.show;
// 如果按下的是鼠标右键,则显示弹出菜单
if (message.lParam=WM_RBUTTONDOWN) then
begin
GetCursorPos( p );
PopupMenu1.Popup( p.x, p.y );
end;
end;

// 安装图标
procedure TForm1.InstallIcon;
var
IconData: TNotifyIconData;
begin
NormalIcon := TIcon.Create;
DisabledIcon := TIcon.Create;
NormalIcon.LoadFromFile( 'E:/!我的资料/我的作品/#MyDelphi/操作任务栏/normal.ico' ); // 允许使用状态下的图标
DisabledIcon.LoadFromFile( 'E:/!我的资料/我的作品/#MyDelphi/操作任务栏/disable.ico' ); // 禁止使用状态下的图标
IconData.cbSize := SizeOf( IconData );
IconData.Wnd := Handle;
IconData.uID := ICON_ID;
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallBackMessage := MI_ICONEVENT;
IconData.hIcon := NormalIcon.Handle;
IconData.szTip := '这是任务栏的状态指示区上加图标的例程' ;
Shell_NotifyIcon( NIM_ADD, @IconData );
end ;

//卸载图标
procedure TForm1.UnInstallIcon;
var
IconData: TNotifyIconData;
begin
IconData.cbSize := SizeOf( IconData );
IconData.Wnd := Handle;
IconData.uID := ICON_ID;
Shell_NotifyIcon( NIM_DELETE, @IconData );
end ;

procedure TForm1.FormCreate(Sender: TObject);
begin
//安装图标并隐藏主窗体
Status := True;
InstallIcon;
ChangeIcon( True );
ShowWindow( Application.Handle, SW_HIDE );
SetWindowLong( Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// 卸载图标并释放图标资源
UnInstallIcon;
NormalIcon.Free;
DisabledIcon.Free;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
// 隐藏Form1
Form1.width := 0;
Form1.Height := 0;
ShowWindow( Application.Handle, SW_HIDE);
end;

procedure TForm1.AppitemClick(Sender: TObject);
begin
Form2.show;
end;

procedure TForm1.EnableOrDisableClick(Sender: TObject);
begin
if (Status = True) then
begin
changeIcon( False );
EnableOrDisable.Caption := '允许使用[&Y]';
end
else
begin
ChangeIcon( True );
EnableOrDisable.Caption := '禁止使用[&D]';
end;
end;

procedure TForm1.ExitItemClick(Sender: TObject);
begin
Close;
end;

end.




---------
unit2.pas
--------------------

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;

type
TForm2 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
procedure N1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.N1Click(Sender: TObject);
begin
Close;
end;



end.
 
多人接受答案了。
 
后退
顶部