Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2005.01.16;
Скачать: [xml.tar.bz2];

Вниз

Программу - в системный трей   Найти похожие ветки 

 
Dr. Genius   (2005-01-01 10:16) [0]

Как можно поместить программу в системный трей без использования библиотеки rxLib? И как при этом можно самому задавать соответствующие пункты меню (и, соответственно, обработчики событий для них) при нажатии правой кнопкой мыши на иконке программы, висящей в трее?


 
Palladin ©   (2005-01-01 10:28) [1]

Все это и многое другое о иконке в трее ты найдешь в ЛЮБОМ поисковике, в ОГРОМНОМ объеме.


 
YurikGL ©   (2005-01-01 10:39) [2]


> И как при этом можно самому задавать соответствующие пункты
> меню (и, соответственно, обработчики событий для них) при
> нажатии правой кнопкой мыши на иконке программы, висящей
> в трее?

Как-как... Вешать popup-меню и обрабатывать onclick :-)  С Новым Годом!


 
трей   (2005-01-01 14:08) [3]

unit Unit1;

interface

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

type
 TNotifyIconBalloon = record
   cbSize: DWORD;
   hWnd: HWND;
   uID: UINT;
   uFlags: UINT;
   uCallbackMessage: UINT;
   hIcon: HICON;
   szTip: array[0..127] of AnsiChar;
   dwState: DWORD;
   dwStateMask: DWORD;
   szInfo: array[0..255] of AnsiChar;
   uTimeout: UINT;
   szInfoTitle: array[0..63] of AnsiChar;
   dwInfoFlags: DWORD;
end;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Button3: TButton;
   PopupMenu1: TPopupMenu;
   ff1: TMenuItem;
   Timer1: TTimer;
   Button4: TButton;
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure PopupMenu1Popup(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   procedure Button4Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   procedure DefaultHandler(var M); override;
   procedure Ico(var M:TMessage); message WM_USER+222;
 end;

var
 Form1: TForm1;
 N:TNotifyIconBalloon;
 WM_TASKBARCREATED:Cardinal;
 g:Boolean;
 b,i:Byte;
implementation

{$R *.dfm}

procedure BalloonHint(NIco,Flag:byte;Title,Text:string);
begin
 N.cbSize:=SizeOf(TNotifyIconBalloon);
 N.uID:=NIco;
 N.uFlags:=$00000010;
 StrPLCopy(N.szInfo,Text,SizeOf(N.szInfo)-1);
 StrPLCopy(N.szInfoTitle,Title,SizeOf(N.szInfoTitle)-1);
 N.uTimeout:=5000;
 N.dwInfoFlags:=Flag;
 Shell_NotifyIcon(NIM_MODIFY,@N);
end;

procedure AddModDelIcon(H:HWND;R,NIco:byte;Icon:HICON;S:string);
begin
 N.cbSize:=SizeOf(TNotifyIconBalloon);
 N.hWnd:=H;
 N.uID:=NIco;
 N.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
 N.uCallbackMessage:=WM_USER+222;
 N.hIcon := Icon;
 StrPLCopy(N.szTip,S,SizeOf(N.szTip)-1);
 if R=1 then Shell_NotifyIcon(NIM_ADD,@N);
 if R=2 then Shell_NotifyIcon(NIM_MODIFY,@N);
 if R=3 then Shell_NotifyIcon(NIM_DELETE,@N);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
AddModDelIcon(Handle,1,1,Application.Icon.Handle,"Add Icon 1")
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
AddModDelIcon(Handle,2,1,LoadIcon(0,MakeIntResource(32513+i)),"Modify Icon");
i:= succ(i) mod 4;
end;

procedure TForm1.Button2Click(Sender: TObject);//Show Balloon
begin //1= INFO; 2= WARNING; 3= ERROR;
BalloonHint(1,b,"Balloon hint",FormatDateTime("Ñåãîäíÿ : dddd"^m"ddddd ã.",Now));
b:= succ(b) mod 4;
end;

procedure TForm1.Button3Click(Sender: TObject);//Hide Balloon
begin
BalloonHint(1,0,"","")
end;

procedure TForm1.Button4Click(Sender: TObject);//Delete end Add Icon
begin
beep;
g:= not g;
if g then AddModDelIcon(Handle,3,1,0,"")//Delete Icon
     else AddModDelIcon(Handle,1,1,Application.Icon.Handle,"Add Icon 1")
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
AddModDelIcon(Handle,3,1,0,"")//Delete Icon
end;

var sX, sY: Integer;
procedure TForm1.Ico(var M:TMessage);
begin
if M.WParam=1 then
case M.LParam of
WM_RBUTTONUP : PopupMenu1.Popup(Mouse.CursorPos.x,Mouse.CursorPos.y-5);
WM_LBUTTONUP : Button1.Click;
WM_MOUSEMOVE: begin
sX:= Mouse.CursorPos.x;
sY:= Mouse.CursorPos.y;
if Timer1.Enabled then exit;
Timer1.Enabled:=true;
Caption:="Mouse YES";
AddModDelIcon(Handle,2,1,LoadIcon(0,IDI_APPLICATION),"Mouse YES")
end;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (Mouse.CursorPos.x <> sX) or (Mouse.CursorPos.y <> sY) then begin
Caption:="Mouse NO";
Timer1.Enabled:=False;
AddModDelIcon(Handle,2,1,Application.Icon.Handle,"")
end;
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
SetForegroundWindow(Handle)
end;

procedure TForm1.DefaultHandler(var M);
begin
if TMessage(M).Msg = WM_TASKBARCREATED then
AddModDelIcon(Handle,1,1,Application.Icon.Handle,"Add Icon 2");
inherited;
end;

initialization
WM_TASKBARCREATED := RegisterWindowMessage("TaskbarCreated");

end.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.01.16;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.066 c
4-1101613952
Yus
2004-11-28 06:52
2005.01.16
Запуск прогпаммы из памяти.


1-1104577794
hawkins
2005-01-01 14:09
2005.01.16
Компонент для работы с html


1-1104205706
DelphiN!
2004-12-28 06:48
2005.01.16
Ошибка при обращении к компонентам из разных Unit-ов в DLL


1-1104514527
Cheguevara
2004-12-31 20:35
2005.01.16
Как юзануть канву в имэдже чтоб сделать прозрачный пиксель


1-1103828956
LedWorm
2004-12-23 22:09
2005.01.16
Пробег по элементам TreeView





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский