Seeing a lot of system trays on the Internet, there are too many things written, but you can't do it, but everyone doesn't seem to solve a problem, that is, click and double-click how to deal with the problem, so I also wrote a post. come out. I hope everyone can give more opinions. If there is any place where there is a place, please don't worry.
This control is simple, you can display icons with Show method, hide the icon with Hide, you can handle the events that click and double-click, and there is a popup menu (pop up when you click right click). You can also change the icon with the icon's property, you can change your prompt with the TIP property.
The method for this control is like this. If only OnClick is set, it is an immediate response. If both are simultaneously defined, you can only respond to OndblClick when you do not say like a normal control, both of them respond.
{********************************************************** ****** Borland Delphi VCL system tray Ver 1.0 author: Tao Hunter@Shentong.com.cn
May 31, 2004 ************************************************************** **********} Unit Notifyicon;
Interface
uses Messages, Windows, SysUtils, Classes, shellapi, StrUtils, Forms, Menus, Graphics; const NotifyMsg = WM_USER 1; // tray custom message type TNotifyIcon = class (TComponent) // derived from TComponent private FData: TnotifyIconData; / / system tray required data FEnabled: Bool; FOnClick: TNotifyEvent; FOnDblClick: TNotifyEvent; FPopupMenu: TPopupMenu; FIcon: TIcon; // tray icon fTimer: Bool; FDblClickTime: Cardinal; procedure setEnabled (Flag: Bool); procedure SetIcon ( h: TICON); procedure SetTip (s: string); function GetTip: string; procedure WndProc (var Msg: TMessage); public constructor Create (AOwner: TComponent); override; destructor Destroy; override; procedure Show; // significant standard Icon Procedure Hide; // Hide Icon Published Property Handle: HWnd Read FData.Wnd; // Tray Handle Property Enabled: Bool Read Fenabled Write SE tEnabled default False; // show or hide the property OnClick: TNotifyEvent read FOnClick Write FOnClick; // response property OnDblClick when clicking the left button: TNotifyEvent read FOnDblClick Write FOnDblClick; // response property PopupMenu when double-clicking the left button: TPopupMenu read FPopupMenu Write FPopupMenu ; // Click Right-click Response, pop-up menu Property Icon: Ticon Read Ficon Write Seticon; // Icon Property Tip: String Read Gettip Write Settip; // Tips End; Procedure Register; Implementation
constructor TNotifyIcon.Create (AOwner: TComponent); // constructor initializes variables begin inherited Create (AOwner); FTimer: = False; FDblClickTime: = GetDoubleClickTime; // Get double click interval FEnabled: = False; FData.Wnd: = Classes.allocatehwnd (wndproc); // Setup callback function fdata.cbsize: = sizeof (tnotifyicondata); fdata.ucallbackMessage: = notifyMsg; tip: = '; fdata.uid: = uint (self); fdata.uflags: = nif_icon nif_tip nif_message; icon: = application.Icon; // default icon in the main program initialization icon end; destructor TNotifyIcon.Destroy; // destructor begin if FEnabled then Enabled: = false; Classes.DeallocateHWnd (FData.Wnd Inherited destroy;
Procedure TNOTICON.SETICON (H: TICON); // Set icon Begin Ficon: = H; fdata.hicon: = ficon.handle; if enabled dam = otifyicon (nim_modify, @ fdata);
Procedure TNOTICON.SETTIP (S: String); // Setting the proposa Begin if Length (s)> 63 THEN S: = Midstr (s, 1, 63); // up to 64 bytes, so more than 63 bytes Need to trunly stropy (fdata.sztip, pchar (s)); if enabled dam_notifyicon (nim_modify, @ fdata);
Function TNOTICON.GETTIP: STRING; / / Get the proposal Begin Result: = fdata.sztip;
Procedure tnotifyicon.show; // On the tray display icon Begin Enabled: = true;
Procedure tnotifyicon.hide; // Hide icon Begin enabled: = false;
procedure TNotifyIcon.SetEnabled (Flag: Bool); // show or hide icons begin if Flag = Fenabled then exit; if Flag then shell_notifyicon (NIM_ADD, @ FData) else shell_notifyicon (NIM_Delete, @ FData); FEnabled: = not FEnabled; end Procedure TNotifyicon.WndProc (var Msg: tMessage); // Tonance function var P: tpoint; begin if msg.msg = notifymsg the beginning msg.lparam of wm_lbuttonup: begin // Left button, if only OnClick is defined Return to IF Assigned (FONCLICK) and NOT ASSIGNED (Fondblclick) and not asset (self); end; 立 立, if you click and double-click the same definition, enable Timer, if Assigned (Fonclick) and assigned (Fondblclick) THEN BEGIN / / DIRE Click or Double-click SetTimer (Handle, 1, FDBLClickTime, NIL); // If it is not fixed, it is not responding to ftimer: = true; end; end; wm_lbuttondblclk: begin // Left button Double-click, if ftimer kilin // If there is a timer, cancel the timer KillTimer (Handle, 1); FTIMER: = false; end; if assigned (self); // If the definition double-clicks responds to END; WM_RBUTTONUP: Begin / / Right-click, response menu if Assigned (fpopupnu) The begin getCursorpos (P); FpopupMenu.Popup (px, py); end; end; end; msg.result: = 0; end else if msg.msg = WM_TIMER THEN BEGIN / / Timer end, response click. KillTimer (Handle, 1); // In clicking, double-click the same definition, no double click on ftimer: = false; fonclick (self); end;
Procedure Register; Begin RegisterComponents ('System', [TNOTICYICON]); END;
End.
