会闪动的托盘程序(50分)

  • 主题发起人 主题发起人 tsedlinux
  • 开始时间 开始时间
T

tsedlinux

Unregistered / Unconfirmed
GUEST, unregistred user!
我想实现一个会闪动的托盘程序,就像QQ来了消息后有个小图标在托盘上闪。我用 Shell_NotifyIcon(NIM_MODIFY,@MyTrayIcon)一点效果都没有。在imagelist1中存放了两个图标,如何调用它们交替在托盘上显示?
 
unit Unit1;

interface

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

const

ICON_ID = 1; // 图标在本应用程序中的编号

MI_ICONEVENT = WM_USER + 1; // 图标上的鼠标事件

type

TForm1 = class(TForm)
pop1: TPopupMenu; // 在图标上右点鼠标时弹出的菜单
status1: TMenuItem; // pop1菜单的第一项,选取它会改变程序的状态
close1: TMenuItem;
Timer1: TTimer; // pop1菜单的最后一项,它会关闭此应用程序



procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure close1Click(Sender: TObject);
procedure status1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);

private

normalicon, disabledicon: TIcon; //需放在状态指示区的图标

status: Boolean;

procedure InstallIcon; //在状态指示区上安装图标

procedure ChangeIcon(status:Boolean);//根据参数,显示不同的图标

procedure UnInstallIcon; //卸载图标

procedure IconOnClick(var message: TMessage); message MI_ICONEVENT; //响应图标上的鼠标事件

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

InstallIcon;

ChangeIcon(False );

ShowWindow(Application.Handle, SW_HIDE ); //隐藏应用程序主窗口机

end;

procedure TForm1.InstallIcon;

var IconData: TNotifyIconData;

begin

normalicon := TIcon.Create;

disabledicon := TIcon.Create;

normalicon.LoadFromFile( 'normal.ico' );

disabledicon.LoadFromFile( '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.ChangeIcon( status: boolean );

var IconData: TNotifyIconData;

begin

IconData.cbSize := SizeOf(IconData);

IconData.wnd := Handle;

IconData.uID := ICON_ID;

if status then IconData.hIcon := normalicon.Handle else IconData.hIcon :=
disabledIcon.Handle;

IconData.uFlags := NIF_ICON;

Shell_NotifyIcon(NIM_MODIFY, @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.IconOnClick( var message: Tmessage);

var p : TPoint;

begin

if (message.lParam = WM_LBUTTONDOWN) then

ShowWindow( Application.Handle, SW_SHOW );

if (message.lParam = WM_RBUTTONDOWN) then begin

GetCursorPos( p );

pop1.Popup( p.x ,p.y );

ChangeIcon( status );

end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

UnInstallIcon;

normalicon.Free;

disabledicon.Free;

end;

procedure TForm1.close1Click(Sender: TObject);

begin

Close;

end;

procedure TForm1.status1Click(Sender: TObject);

begin

status := not status;

if status then status1.Caption := 'Enable'

else status1.Caption := 'Disable';

end;



procedure TForm1.Timer1Timer(Sender: TObject);

begin
status:=not status;
ChangeIcon( status );
end;

end.







object Form1: TForm1
Left = 215
Top = 156
Width = 129
Height = 116
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object pop1: TPopupMenu
Left = 32
Top = 32
object status1: TMenuItem
Caption = 'ChangeIcon'
Checked = True
OnClick = status1Click
end
object close1: TMenuItem
Caption = 'Exit'
OnClick = close1Click
end
end
object Timer1: TTimer
Interval = 500
OnTimer = Timer1Timer
Left = 32
Top = 4
end
end
 
BUBBLE兄:
我想让那两个图标从程序里调用,不想让它作为文件形式从外部调入,有什么办法吗?
 
用 Rx Library 控件!
 
tsedlinux:
很简单,如果想从程序中调用,就把这两个图标用资源文件LOAD进来,在程序中调用资源文件
,编译后可以脱离资源文件运行。
 
请告诉我如何从资源文件调图标?最好有个例子
 
http://www.csdn.net/develop/Read_Article.asp?Id=13056
 
多人接受答案了。
 
后退
顶部