首页  编辑  

TrayIcon控件

Tags: /超级猛料/VCL/Control.控件使用开发和第三方控件/自定义控件/   Date Created:

]、。·ˉˇ¨〃々—~‖…’”〕〉》」』〗】∶!"'),.:;?]` --回复得分 0 --

1、虽然在Delphi中把窗口的属性BorderStyle设为bsNone可以

让标题栏消失,但同时窗口却不能缩放了,下面这段代码可以使你

鱼和熊掌兼得:

procedure TForm1.FormCreate(Sender: TObject);

begin

 SetWindowLong(Handle,GWL_STYLE, GetWindowLong(Handle,GWL_STYLE)

 AND NOT WS_CAPTION);

 ClientHeight := Height;

end;

2、TNotifyIcon 控件1.01 (Build use Delphi 3.0) 说明:

作用:

往通知区加图标,并可显示,隐藏,修改这个图标.

 

属性(properties):

NotifyIcon:TIcon  欲加在通知区的图标

IsVisible:boolean NotifyIcon是否显示的属性

Title:string  通知区图标上的提示(最多64个字符)

PopupMenu:TPopupMenu 点击通知区图标弹出的菜单

PopupStyle:TPopupStyle 弹出菜单的方式            

 TPopupStyle=Set of (Left_Click,Right_Click,Left_DbClick,Right_DbClick);

方法(methods):  

  ShowIcon  将图标显示在通知区上

  HideIcon  将通知区上的图标隐藏

  ModifyIcon 修改通知区上的图标(若IsVisible=false,则不显示出来)

  Create(AOwner: TComponent); override; 构造方法

  Destroy; override; 析构方法

事件(Events):

   OnIconMouseDown:

     procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton) of Object;

     (

      在Mouse点击通知区上的图标时发生,x,y为Mouse在屏幕上的坐标,

      WhoButton=b_Left为点击左键,WhoButton=b_Right为点击右键,

     )

   OnIconDoubleClick:

     procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton) of Object;

    (

     在Mouse双击通知区上的图标时发生,x,y为Mouse在屏幕上的坐标,

     WhoButton=b_Left为双击左键,WhoButton=b_Right为双击右键,

    )

关于Demo:

  这个演示程序给出了TNotifyIcon的基本用法.

包含文件:

NotifyIcon.dcr

NotifyIcon.pas

DemoUnit.pas

DemoUnit.dfm

PopUnit.pas

PopUnit.dfm

Demo.dpr

Readme.txt

声明:

    TNotifyIcon 控件 V 1.01

1.这是一个免费控件.

2.如果你使用它,请发一个E-Mail给作者,谢谢.

3我在Delphi3.0 & 4.0 上使用成功

4.若要传播它,请完全分发上述8个文件

    作者  南昌大学计算系95(1)  付昱纲 1998.8.17  21:50

    E-mail   fyg@163.net  

unit NotifyIcon;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

 DsgnIntf,ShellApi,ExtCtrls,Menus;

const

     WM_MY_Notify=WM_USER+100;

type

 TPopupStyle=Set of (Left_Click,Right_Click,Left_DbClick,Right_DbClick);

 TWhoButton=(b_Left,b_Right);

 TMouseEvent=

 procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton)

     of Object;

//---------class TNotifyIcon---------

 TNotifyIcon = class(TCustomControl)

 private

   { Private declarations }

   FIcon:TIcon;

   FPda:PNOTIFYICONDATA;

   FTitle:string;

   FIconVisible:boolean;

   FPopupMenu:TPopupMenu;

   FPopupStyle:TPopupStyle;

   FOnIconMouseDown:TMouseEvent;

   FOnIconDoubleClick:TMouseEvent;

   procedure SetIcon(Icon:TICON);

   procedure SetTitle(NewTitle:string);

   function IsShowing:boolean;

   procedure ShowIt(Accept:boolean);

   procedure NotifyIconClick(var msg : TMessage);

     Message WM_My_Notify;

 protected

   { Protected declarations }

  public

   { Public declarations }

  property IsVisible:boolean read IsShowing write ShowIt;

  constructor Create(AOwner: TComponent); override;

  procedure ShowIcon;

  procedure HideIcon;

  destructor Destroy; override;

  procedure ModifyIcon(NewIcon:TIcon);

  procedure Paint;override;

 published

   { Published declarations }

   property Height default 33;

   property Width  default 33;

   property NotifyIcon:TIcon read FIcon  write SetIcon;

   property Title:string read FTitle write SetTitle ;

   property OnIconDoubleClick:TMouseEvent

     read FOnIconDoubleClick write FOnIconDoubleClick;

   property OnIconMouseDown:TMouseEvent

     read FOnIconMouseDown write FOnIconMouseDown;

   property PopupMenu:TPopupMenu read FPopupMenu write FPopupMenu;

   property PopupStyle:TPopupStyle read FPopupStyle

               write FPopupStyle default [];

end;

procedure Register;

implementation

procedure Register;

begin

 RegisterComponents('MyControl', [TNotifyIcon]);

end;

procedure TNotifyIcon.ShowIt(Accept:boolean);

begin

 if  Accept=true then ShowIcon

 else HideIcon;

end;

procedure TNotifyIcon.Paint;

begin

if (csDesigning in ComponentState) then

begin

Width:=33;

Height:=33;

With Canvas do

begin

 Brush.Color:=clInfoBk;

 Ellipse(0,0,Self.Width,Self.Height);

 Font.Color:=clBlue;

 Brush.Style:=bsClear;

 FloodFill(5,5,clInfoBk,fsBorder);

 Brush.Color:=clInfoBk;

 TextOut(3,Self.Height div 2-6,'Notify');

end

end;

end;

procedure TNotifyIcon.NotifyIconClick(var msg : TMessage);

var p:TPoint;

begin

try

    case msg.LParam of

     WM_LBUTTONDOWN:

       begin

        GetCursorPos(p);

        if Left_Click in FPopupStyle then

        begin

          SetForegroundWindow(ParentWindow);

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

        end;

        if Assigned(FOnIconMouseDown) then

        begin

          FOnIconMouseDown(Self,p.x,p.y,b_Left);

        end;

       end;

     WM_RBUTTONDOWN:

       begin

        GetCursorPos(p);

        if Right_Click in  FPopupStyle then

        begin

          SetForegroundWindow(ParentWindow);

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

        end;

        if Assigned(FOnIconMouseDown) then

        begin

          FOnIconMouseDown(Self,p.x,p.y,b_Right);

        end;

       end;

     WM_LBUTTONDBLCLK:

       begin

        GetCursorPos(p);

        if Left_DbClick in FPopupStyle then

        begin

          SetForegroundWindow(ParentWindow);

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

        end;

        if Assigned(FOnIconDoubleClick) then

        begin

          FOnIconDoubleClick(Self,p.x,p.y,b_Left);

        end;

       end;

     WM_RBUTTONDBLCLk:

       begin

        GetCursorPos(p);

        if Right_Click in FPopupStyle then

        begin

          SetForegroundWindow(ParentWindow);

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

        end;

        if Assigned(FOnIconDoubleClick) then

        begin

          FOnIconDoubleClick(Self,p.x,p.y,b_Right);

        end;

       end;

    end;

except

end;

end;

function MAKELANGID(p, s:word):Cardinal;

begin

 result:= (((s)shl 10) or(p));

end;

constructor TNotifyIcon.Create(AOwner: TComponent);

begin

try

inherited Create(AOwner);

FIcon:=TIcon.Create;

Height:=36;

Width:=36;

Visible:=false;

FTitle:='Welcome';

FIconVisible:=false;

//-------------set tray info---------

ParentWindow:=TWinControl(AOwner).Handle;

New(Fpda);

 With FPda^ do

 begin

   uCallbackMessage:=WM_MY_Notify;

   cbsize:=SizeOf(FPda^);

   uID:=200;

   wnd:=Handle;

   uFlags:=NIF_ICON+NIF_Tip+NIF_MESSAGE;

  end;

if (csDesigning in ComponentState) then

begin

if GetUserDefaultLCID = MAKELANGID(LANG_CHINESE,SUBLANG_CHINESE_SIMPLIFIED) then

     Application.MessageBox(

   'Write by 南昌大学 付昱纲'#13#13'E-mail:fyg@163.net'#13#13'           1998.8.17',

   'TNotifyIcon 控件 V 1.01',MB_OK+ MB_ICONINFORMATION)

else

     Application.MessageBox(

   'Write by NanChang University  FuYuGang'#13#13'E-mail:fyg@163.net'#13#13'           1998.8.17',

   'TNotifyIcon Component V 1.01',MB_OK+ MB_ICONINFORMATION);

end;

except

 ShowMessage('TNotifyIcon Create error');

end;

end;

procedure TNotifyIcon.SetIcon(Icon:TICON);

begin

FIcon.Assign(Icon);

end;

procedure TNotifyIcon.ShowIcon;

begin

try

if FIcon.Handle=0 then

begin

   Exit;

end;

if FIcon.Handle<>FPda^.hIcon then

      HideIcon;

if FIconVisible=false then

begin

 FPda^.hIcon:=FIcon.handle;

 FIconVisible:=true;

  Shell_NotifyIcon(NiM_ADD,FPda);

end;

except

ShowMessage('TNotifyIcon Show Error ');

end;

end;

procedure TNotifyIcon.HideIcon;

begin

try

if FIconVisible then

begin

 FIconVisible:=false;

 Shell_NotifyIcon(NiM_DELETE,FPda);

end;

except

ShowMessage('TNotifyIcon Hide Error');

end;

end;

procedure TNotifyIcon.SetTitle(NewTitle:string);

begin

FTitle:=NewTitle;

StrCopy(FPda^.szTip,PChar(FTitle));

if FIconVisible then

begin

  HideIcon;

  ShowIcon;

end;

end;

destructor TNotifyIcon.Destroy;

begin

try

 HideIcon;

 Dispose(FPda);

 FIcon.Free;

inherited Destroy;

except

ShowMessage('TNotifyIcon Destroy Error');

end;

end;

procedure TNotifyIcon.ModifyIcon(NewIcon:TIcon);

begin

try

SetIcon(NewIcon);

FPda^.hIcon:=FIcon.handle;

if FIconVisible  then

  Shell_NotifyIcon(NiM_Modify,FPda);

except

ShowMessage('TNotifyIcon Modify Error');

end;

end;

function TNotifyIcon.IsShowing:boolean;

begin

 Result:=FIconVisible;

end;

end.

--回复得分 0 --

Firing_sky 说得很详细了,但是要做通知栏的图标也很简单,应用几个函数(自己写),

InstallIcon,UnInstallIcon,IconClick.

下面是他们的简单实例:

安装图表:

procedure TForm1.InstallIcon;

var

  CDIcon:TNotifyICondata;

begin

  normalIcon:=TIcon.Create;

  normalIcon:=form1.Icon;

  CDIcon.cbSize:=sizeof(CDIcon);

  CDIcon.Wnd:=handle;

  CDIcon.uID:=ICON_ID;

  CDIcon.uFlags:= NIF_ICON or NIF_MESSAGE or NIF_TIP;

  CDIcon.uCallbackMessage:=MI_ICONEVENT;

  CDIcon.hIcon:=normalicon.Handle;

  CDIcon.szTip:='光驱控制';

  Shell_NotifyIcon(NIM_ADD,@CDIcon);

end;

卸载图标:

procedure TForm1.UnInstallIcon;

var

  CDIcon:TNotifyIconData;

begin

  CDIcon.cbSize:=sizeof(CDIcon);

  CDIcon.Wnd:=Handle;

  CDIcon.uID:=ICON_ID;

  Shell_NotifyIcon(NIM_DELETE,@CDIcon);

//   normalIcon.Free;

end;

响应click事件:

procedure TForm1.IconOnClick(var message:TMessage);

var

 p:TPoint;

begin

  if  (message.LParam=WM_LBUTTONDBLCLK) then

      ShowWindow(handle,SW_SHOW);

  if  (message.LParam=WM_RBUTTONDOWN) then

    begin

       GetCursorPos(p);

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

    end;

end;