Witam wszystkich.
Po dłuższej przerwie w programowaniu (kilka miesięcy) postanowiłem (z nudów) spróbować znowu swoich sił, w tworzeniu Traya od zera :-) Kiedyś bawiłem się tym ale coś nie bardzo działało.
Teraz jest lepiej - wyświetla ikony programów (wreszcie poprawnie), prócz tych systemowych czyli np. ikony głośności, połączenia sieciowego itd. Szukając w google cosik na ten temat natrafiłem na ten oto wątek na tutejszym forum:
http://4programmers.net/Forum/viewtopic.php?id=113816&start=10
oraz na:
http://xoblite.net/source/TrayManager.cpp.html
No i próbuję to przerobić na kod dla Delphi (tylko WinAPI!).
Działa częściowo tzn. gdy dochodzi do załadowania ostatniego obiektu (SysTray) to aplikacja się okropnie muli, czasem zawiesza. Raz zobaczyłem ikonę głośności więc nie jest źle :)
na pewno cosik namieszałem. Mam nadzieję, że pomożecie.
uses
Windows,
Messages,
ShellApi,
SysUtils,
ActiveX;
procedure LoadShellServiceObjects;
const
IID_IOleCommandTarget: TGUID = '{B722BCCB-4E68-101B-A2BC-00AA00404770}';
CGID_ShellServiceObject: TGUID = (D1:$000214D2; D2:$0; D3:$0; D4:($C0,0,0,0,0,0,0,$46));
var
Res: HRESULT;
ErrorCode: LongInt;
hKeyServices: HKEY;
I: Integer;
szValueName: Array [0..31] of Char;
szData: Array [0..39] of Char;
cbValueName: DWORD;
cbData: DWORD;
dwDataType: DWORD;
wszCLSID: Array [0..39] of WChar;
_clsid: TCLSID;
pCmdTarget: IOleCommandTarget;
//ov: OleVariant;
msg: string;
error: longint;
begin
Res := CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE or COINIT_SPEED_OVER_MEMORY);
ErrorCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\ShellServiceObjectDelayLoad', 0, KEY_READ, hKeyServices);
I := 0;
while (ErrorCode = ERROR_SUCCESS) do
begin
ZeroMemory(@szValueName, Sizeof(szValueName));
ZeroMemory(@szData, Sizeof(szData));
cbValueName := 32;
cbData := 40;
dwDataType := 0;
ErrorCode := RegEnumValue(hKeyServices, I, szValueName, cbValueName, nil, @dwDataType, @szData, @cbData);
msg := szValueName + ' ' + szData;
if (MessageBox(GetDesktopWindow(), pchar(msg), 'debug', MB_YESNO or MB_ICONQUESTION or MB_SETFOREGROUND or MB_TOPMOST) = IDNO)
then
begin
Inc(I);
Continue;
end;
if (ErrorCode = ERROR_SUCCESS) then
begin
ZeroMemory(@wszCLSID, Sizeof(wszCLSID));
ZeroMemory(@_clsid, Sizeof(_clsid));
ZeroMemory(@pCmdTarget, Sizeof(pCmdTarget));
MultiByteToWideChar(CP_ACP, 0, szData, cbData, wszCLSID, 40);
CLSIDFromString(wszCLSID, _clsid);
Res := CoCreateInstance(_clsid, nil, CLSCTX_INPROC_SERVER or CLSCTX_INPROC_HANDLER, IID_IOleCommandTarget, pCmdTarget);
MessageBox(0, PChar(IntToStr(Res)), 'Res', 0);
if (Res = S_OK) then
begin
MessageBox(0, PChar(IntToStr(I)), '', 0);
error:=pCmdTarget.Exec(@CGID_ShellServiceObject, 2, 0, 0, {ov}POLEVariant(nil)^);
if error = S_OK then MessageBox(0, 'Exec OK!', 'Exec', 0)
else pCmdTarget._Release;
if i = 3 then break; //cosik sprawdzalem ;D
end;
end;
Inc(I);
end;
RegCloseKey(hKeyServices);
end;
Wybaczcie za lekki bajzel w kodzie - na razie testuję czy w ogóle wszystko zadziała jak należy.
Jak to będzie skończone to całą funkcję przepiszę tak by była czytelna i zoptymalizowana no i wrzucę na forum :)
EDIT:
Jednak działa :D Błąd powodowała pewna funkcja w innym miejscu. Jutro doszlifuje tę procedurę bo teraz jest - jak to zawsze określam jak coś mi się nie podoba - "z d**y" [green]