Mam taki problem, chcialbym by ikonki w tray-u odswiezaly sie np. co 5min. Niektore programy nawet po zamknieciu zostawiaja swa ikonke i zniaka ona po najechaniu na nia myszka. Jak moze wygladac taki skrypt??
Prosze o pomoc.
0
0
po zamknięciu programu ikonka w traju zostanie jesli w programie jej nie wyłączysz lub program nagle zamknie się (np gdy zabijesz mu proces)
w delphi wyłącza się np : Shell_NotifyIcon(NIM_DELETE, @IconNotifyData); gdzie
IconNotifyData : TNotifyIconData; ale też nie umiem zmieniać ikonki tak gładko jak np antywirus avast :], któremu się obraca
0
Dzieki za to, ale to mi niepomoglo, mnie chodzi oto ze ja chcialbym odswiezac wszystkie ikonki w trayu czyli jesli jest tam gg,ati,tlen itp co jakies 5min. Nie tylko mojego programu. Da sie cos takiego zrobic?? cos jak program "PS Tray Factory" tylko by robil odswiezanie nic wiecej??
0
madshi collection - http://help.madshi.net/TrayIcons.htm
0
Sprawdź czy to działa, teoretycznie powinno.
var
hShell_TrayWnd, hTrayNotifyWnd: THandle;
begin
hShell_TrayWnd:= FindWindow('Shell_TrayWnd', nil);
hTrayNotifyWnd:= FindWindowEx(hShell_TrayWnd, 0, 'TrayNotifyWnd', nil);
InvalidateRect(hTrayNotifyWnd, nil, True);
end;
Jeżeli nie działa sprawdź czy wartości hShell_TrayWnd i hTrayNotifyWnd są różne od 0 bo nie wiem jakie nazwy klas mają być w XP podałem z 98.
0
Wiesz co jednak nie chodzi mialem wlaczonego PS Tray Factory i zapomnialem o tym, on wylaczal ikonke :)
0
Gdzie sprawdzić czy wartości hShell_TrayWnd i hTrayNotifyWnd są różne od 0 ??
0
MaRWiD napisał(a)
Gdzie sprawdzić czy wartości hShell_TrayWnd i hTrayNotifyWnd są różne od 0 ??
Delphi ma wbudowany debugger. Ustaw sobie breakpointa na 1 linii i obserwuj wartości zmiennych a jak jesteś leniwy to:
var
hShell_TrayWnd, hTrayNotifyWnd: THandle;
begin
hShell_TrayWnd:= FindWindow('Shell_TrayWnd', nil);
ShowMessage('hShell_TrayWnd = ' + IntToStr(hShell_TrayWnd));
hTrayNotifyWnd:= FindWindowEx(hShell_TrayWnd, 0, 'TrayNotifyWnd', nil);
ShowMessage('hTrayNotifyWnd = ' + IntToStr(hTrayNotifyWnd));
InvalidateRect(hTrayNotifyWnd, nil, True);
end;
0
Tu nie oto chodzi czy jestem leniwy tylko oto ze dopiero sie ucze programowac i dlatego niekiedy jestem zielony :)
0
wyświetliło mi sie hShell_TrayWnd=65882
hTrayNotifyWnd=65886
i Co mam z tym zrobic?? W jaki sposóbmam to wykorzystać??
0
MaRWiD napisał(a)
wyświetliło mi sie hShell_TrayWnd=65882
hTrayNotifyWnd=65886
i Co mam z tym zrobic?? W jaki sposóbmam to wykorzystać??
W żaden, to miał tylko sprawdzić czy mój kod jest poprawny - wyszło na to że tak (Windows powinien wysłać komunikat WM_PAINT do Traya aby go przemalować), ale jeżeli mimo tego ikonki nie są odświeżane, musisz spróbować pobawić się tym kodem z interfejsami co ktoś przedemną napisał.
EDIT: Jeszcze spróbuj na sekundę ukryć okno Traya, może wtedy odświeży ikonki.
var
hShell_TrayWnd, hTrayNotifyWnd: THandle;
begin
hShell_TrayWnd:= FindWindow('Shell_TrayWnd', nil);
hTrayNotifyWnd:= FindWindowEx(hShell_TrayWnd, 0, 'TrayNotifyWnd', nil);
ShowWindow(hTrayNotifyWnd, SW_HIDE);
Sleep(1000);
ShowWindow(hTrayNotifyWnd, SW_SHOW);
end;
0
Probowalem to i nic, znikl caly tray na sekunde ale nic sie w nim nie stalo :(
0
No to niestety tylko te interfejsy. Niestety nie ma gotowej funkcji do obsługi ikonek traya należących do innych aplikacji.
0
To jesli nie da sie jak na ta chwile odswiezyc wszyskich ikonek w tray-u to czy da sie przynajmniej jedna z podanym adresem pliku??
0
MaRWiD napisał(a)
To jesli nie da sie jak na ta chwile odswiezyc wszyskich ikonek w tray-u to czy da sie przynajmniej jedna z podanym adresem pliku??
Da się i to bardzo prosto pod warunkiem, że zainstalujesz pakiet który proponował ci <B>ŁF</B> http://madshi.net/madCollection.exe Pakiet jest darmowy do użytku nie komercyjnego.
A to przykład do uses dodaj madKernel :
function RefreshTrayIcon(AppPath: string): Boolean;
var
i: integer;
begin
result:= False;
TrayIcons.RefreshItems;
for i:= 0 to TrayIcons.ItemCount -1 do
begin
if lstrcmpi(PChar(TrayIcons[i].Window.OwnerProcess.ExeFile),
PChar(AppPath)) = 0 then
begin
TrayIcons[i].Hide;
Sleep(1000);
TrayIcons[i].Show;
result:= True;
break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RefreshTrayIcon('C:\Program Files\Gadu-Gadu\GG.exe');
end;
0
Dzieki, powinno mi to wystarczyc, Mozna dodac jeszcze inne sciezki programow i tez beda wszystkie dzialac?? Mnie sie zdaje ze chyba tak, zobacze, na razie sciagam plik :)
0
MaRWiD napisał(a)
Dzieki, powinno mi to wystarczyc, Mozna dodac jeszcze inne sciezki programow i tez beda wszystkie dzialac?? Mnie sie zdaje ze chyba tak, zobacze, na razie sciagam plik :)
Będą działać. Pakiet jest super ma też dużo inych ciekawych funkcji min. fajną funkcje przechwytywania i raportowania błędów.
0
Zainstalowalem sobie madKernel skopiowalem pliki z katalogu madCollection do katalogu delphi, wpisalem w uses madKernel, a wychodza mi bledy, daje kod ponizej:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, madKernel;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function RefreshTrayIcon(AppPath: string): Boolean;
var
Form1: TForm1;
i: integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
result:= False;
TrayIcons.RefreshItems;
for i:= 0 to TrayIcons.ItemCount -1 do
begin
if lstrcmpi(PChar(TrayIcons[i].Window.OwnerProcess.ExeFile),
PChar(AppPath)) = 0 then
begin
TrayIcons[i].Hide;
Sleep(1000);
TrayIcons[i].Show;
result:= True;
break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RefreshTrayIcon('C:\program Files\Gadu-Gadu\GG.exe');
end;
end.
0
MaRWiD napisał(a)
Zainstalowalem sobie madKernel skopiowalem pliki z katalogu madCollection do katalogu delphi, wpisalem w uses madKernel, a wychodza mi bledy, daje kod ponizej:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, madKernel;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function RefreshTrayIcon(AppPath: string): Boolean;
var
Form1: TForm1;
i: integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
result:= False;
TrayIcons.RefreshItems;
for i:= 0 to TrayIcons.ItemCount -1 do
begin
if lstrcmpi(PChar(TrayIcons[i].Window.OwnerProcess.ExeFile),
PChar(AppPath)) = 0 then
begin
TrayIcons[i].Hide;
Sleep(1000);
TrayIcons[i].Show;
result:= True;
break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RefreshTrayIcon('C:\program Files\Gadu-Gadu\GG.exe');
end;
end.
Troche namieszałeś:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, madKernel;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function RefreshTrayIcon(AppPath: string): Boolean;
var
Form1: TForm1;
implementation
{$R *.dfm}
function RefreshTrayIcon(AppPath: string): Boolean; //<--- To było zle
var
i: integer; // i też lepiej niech bedzie zmienna lokalną
begin
result:= False;
TrayIcons.RefreshItems;
for i:= 0 to TrayIcons.ItemCount -1 do
begin
if lstrcmpi(PChar(TrayIcons[i].Window.OwnerProcess.ExeFile),
PChar(AppPath)) = 0 then
begin
TrayIcons[i].Hide;
Sleep(1000);
TrayIcons[i].Show;
result:= True;
break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RefreshTrayIcon('C:\program Files\Gadu-Gadu\GG.exe');
end;
end.
0
Cholera nie wiem co jest :( mam WIN XP
Mam
ten skrypt: Wszytko sie kompiluje, a nic sie nie dzieje!! Zupelnie nic :( Juz sie zalamalem :(
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, madKernel;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
function RefreshTrayIcon(AppPath: string): Boolean;
var
Form1: TForm1;
implementation
{$R *.dfm}
function RefreshTrayIcon(AppPath: string): Boolean; //<--- to było zle
var
i: integer; // i też lepiej niech bedzie zmienna lokalną
begin
result:= False;
TrayIcons.RefreshItems;
for i:= 0 to TrayIcons.ItemCount -1 do
begin
if lstrcmpi(PChar(TrayIcons[i].Window.OwnerProcess.ExeFile),
PChar(AppPath)) = 0 then
begin
TrayIcons[i].Hide;
Sleep(1000);
TrayIcons[i].Show;
result:= True;
break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RefreshTrayIcon('C:\SBCL.exe');
end;
end.
0
Spróbuj wyświetlić listę programów które mają ikonki na Trayu
Czyli tymczasowo tak przerób funkcję:
function RefreshTrayIcon(AppPath: string): Boolean;
var
i: integer;
begin
result:= False;
TrayIcons.RefreshItems;
for i:= 0 to TrayIcons.ItemCount -1 do
begin
ShowMessage(TrayIcons[i].Window.OwnerProcess.ExeFile);
end;
end;
Napisz czy wyświetla nazwy programów, ja już dzisiaj wyłanczam kompa, jak coś to jutro sprawdze na XP
0
Nic mi sie nie wyswietlilo ...
puste okienko
0
MaRWiD napisał(a)
Nic mi sie nie wyswietlilo ...
puste okienko
Ok jutro sprawdze czy to faktycznie nie działa na XP, czy zrobiłeś jakś błąd. Jutro popołudniu napisze odpowiedź (chyba że coś mi wypadnie np. bak netu)
0
Wilkie dzieki za pomoc :) Mozesz tez jakby co napisac na moje podane gg
0
Niestety nie działa na Windows XP :( Na stronie pisze że działa więc już sam nie wiem co jest źle. Na Windows 98 wszystko śmiga bez problemu. Napisałem posta na forum autora tego pakietu może odpowie (jak zrozumie mój kaleczony angielski). Na razie pozostaje czekać, bo nic mądrego nie mogę wymyślić.
0
Nestety teraz bedziemy czekac, ale moze moze, mam wielka nadzieje ze to odpali :)
0
He he ,jestes zajefajny, TO DZIŁA :) [!!!] Dla tylko ostatniej ikonki ale dziala, mozna dac w petle i bedzie oki [!!!]
Oto kod:
var
wnd : cardinal;
rec : TRect;
w,h : integer;
x,y : integer;
begin
// find a handle of a tray
wnd := FindWindow('Shell_TrayWnd', nil);
wnd := FindWindowEx(wnd, 0, 'TrayNotifyWnd', nil);
wnd := FindWindowEx(wnd, 0, 'SysPager', nil);
wnd := FindWindowEx(wnd, 0, 'ToolbarWindow32', nil);
// get client rectangle (needed for width and height of tray)
windows.GetClientRect(wnd, rec);
// get size of small icons
w := GetSystemMetrics(sm_cxsmicon);
h := GetSystemMetrics(sm_cysmicon);
// initial y position of mouse - half of height of icon
y := w shr 1;
while y < rec.Bottom do begin // while y < height of tray
x := h shr 1; // initial x position of mouse - half of width of icon
while x < rec.Right do begin // while x < width of tray
SendMessage(wnd, wm_mousemove, 0, y shl 16 or x); // simulate moving mouse over an icon
x := x + w; // add width of icon to x position
end;
y := y + h; // add height of icon to y position
end;
0
A ten dziala ort! ile jest ikonek :
var
TrayWindow : HWnd;
WindowRect : TRect;
SmallIconWidth : Integer;
SmallIconHeight : Integer;
CursorPos : TPoint;
Row : Integer;
Col : Integer;
begin
{ Get tray window handle and bounding rectangle }
TrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd',NIL),0,'TrayNotifyWnd',NIL);
if not GetWindowRect(TrayWindow,WindowRect) then Exit;
{ Get small icon metrics }
SmallIconWidth := GetSystemMetrics(SM_CXSMICON);
SmallIconHeight := GetSystemMetrics(SM_CYSMICON);
{ Save current mouse position }
GetCursorPos(CursorPos);
{ Sweep the mouse cursor over each icon in the tray in both dimensions }
with WindowRect do
for Row := 0 to (Bottom - Top) DIV SmallIconHeight do
for Col := 0 to (Right - Left) DIV SmallIconWidth do
begin
SetCursorPos(Left + Col * SmallIconWidth, Top + Row * SmallIconHeight);
Sleep(0);
end;
{ Restore mouse position }
SetCursorPos(CursorPos.X,CursorPos.Y);
{ Redraw tray window (to fix bug in multi-line tray area) }
RedrawWindow(TrayWindow,NIL,0,RDW_INVALIDATE OR RDW_ERASE OR RDW_UPDATENOW);
end.