System tray
Code: |
uses {©Drkb v.3}
windows, messages, ShellAPI;
const ClassName = 'MyClockWndClass';
var hTrayClock,Window:hWnd; idTM:cardinal;
function SysDateToStr: string; const sDateFmt = 'dddd, d MMMM yyyy'; var ST : TSystemTime; begin GetLocalTime(ST); SetLength(Result, MAX_PATH); GetDateFormat(LOCALE_USER_DEFAULT,0, @ST,pchar(sDateFmt), @Result[1], MAX_PATH); end;
function SysTimeToStr:string; const sTimeFmt = 'HH:mm'; var ST : TSystemTime; begin GetLocalTime(ST); SetLength(Result,15); GetTimeFormat(LOCALE_USER_DEFAULT,0,@st,sTimeFmt,@Result[1],15); end;
procedure TimerProc(wnd:HWND;uMsg,idEvent,dwTime:UINT);stdcall; begin InvalidateRect(wnd,nil,true); end;
procedure RecalcWndPos; var r:TRect; X,Y:integer; begin X:=GetSystemMetrics(SM_CXDLGFRAME); Y:=GetSystemMetrics(SM_CYDLGFRAME); GetWindowRect(hTrayClock,r); SetWindowPos(Window,0,r.Left+X,r.Top+Y, r.Right-r.Left,r.Bottom-r.Top-Y,0); end;
function AppWndProc(wnd: HWND; uMsg:DWORD; wParam: WPARAM; lParam: LPARAM): Longint; stdcall; var DC : HDC; ps :TPaintStruct; pt :TPoint; r :TRect; Cmd : LongBool; hm:HMenu; begin Result := 0; case uMsg of
WM_SETTINGCHANGE: if wParam=SPI_SETWORKAREA then RecalcWndPos; WM_PAINT: begin DC:=BeginPaint(wnd,ps); GetClientRect(wnd,r); SetBkMode(DC,TRANSPARENT); SetTextColor(DC,RGB(255,255,0)); DrawText(DC,PChar(SysTimeToStr),-1,r,DT_SINGLELINE or DT_CENTER or DT_VCENTER); EndPaint(wnd,ps); exit; end; WM_RBUTTONDOWN: begin hm:=CreatePopupMenu; pt.X:=LOWORD(lParam); pt.Y:=HIWORD(lParam); ClientToScreen(wnd,pt); Insertmenu(hm,0,MF_BYPOSITION or MF_STRING,$101,'Exit'); Insertmenu(hm,0,MF_BYPOSITION or MF_SEPARATOR,0,nil); Insertmenu(hm,0,MF_BYPOSITION or MF_STRING,$102,'Date/Time Settings'); Insertmenu(hm,0,MF_BYPOSITION or MF_SEPARATOR,0,nil); Insertmenu(hm,0,MF_BYPOSITION or MF_STRING,dword(-1),PChar(SysDateToStr)); SetMenuDefaultItem(hm,0,1); Cmd:=TrackPopupMenu(hM,TPM_LEFTALIGN or TPM_RIGHTBUTTON or TPM_RETURNCMD,pt.X,pt.Y,0,Window,nil); case longint(Cmd) of $101: SendMessage(wnd,wm_destroy,0,0); $102: ShellExecute(0,nil,'control.exe','date/time',nil,SW_SHOW); end; DestroyMenu(hm); end; WM_DESTROY: begin PostQuitMessage(wparam); KillTimer(wnd,idTM); end end; Result := DefWindowProc(wnd, uMsg, wParam, lParam); end;
procedure InitInstance; var AppWinClass: TWndClass; begin with AppWinClass do begin style:= CS_VREDRAW or CS_HREDRAW; lpfnWndProc:= @AppWndProc; cbClsExtra:= 0; cbWndExtra:= 0; hInstance:= hInstance; hIcon:= LoadIcon(0,IDI_APPLICATION); hCursor:= LoadCursor(0,IDC_ARROW); hbrBackground:= GetStockObject(BLACK_BRUSH); lpszMenuName:= nil; lpszClassName:= ClassName; end; if RegisterClass(AppWinClass)=0 then Halt(1) end;
procedure InitApplication; begin hTrayClock:=FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'TrayNotifyWnd',nil),0,'TrayClockWClass',nil); Window := CreateWindow(ClassName,nil, WS_POPUP or WS_DLGFRAME, 0,0,0,0, hTrayClock,0,HInstance,nil); If Window=0 then halt(1); RecalcWndPos; end;
procedure InitWindow; begin idTM:=SetTimer(Window,1,1000,@TimerProc); ShowWindow(Window, SW_SHOWNORMAL); UpdateWindow(Window); InvalidateRect(Window,nil,True) end;
procedure MsgLoop; var Message:TMsg; begin while GetMessage(Message, 0, 0, 0) do begin TranslateMessage(Message); DispatchMessage(Message); end; Halt(Message.wParam) end;
begin InitInstance; InitApplication; InitWindow; MsgLoop end. |
но правильнее было бы внедриться в Explorer и сабклассировать TrayClockWClass
- Подробности
- Родительская категория: Windows
- Категория: System tray
Иногда, при потере фокуса, всплывающее меню в System Tray при потере фокуса не закрывается. Поэтому, при обработке сообщений для всплывающего меню необходимо поместить окно на передний план и послать ему сообщение WM_NULL.
- Подробности
- Родительская категория: Windows
- Категория: System tray
Многие программы показывают Pop-Up меню при щелчке на их иконке, помещенной на Tray, как этого добиться ?
Вы должны обрабатывать сообщение, указанное вами при добавлении иконки на Tray. При значении (UINT)lParam, равном WM_RBUTTONDOWN (это обычно дял Pop-Up меню по правой кнопке), или любому другому необходимому вам, вы должны вызовом функции GetCursorPos() получить позицию курсора в момент события (вряд ли пользователь успеет убрать мышь за время обработки сообщения, особенно если он ожидает меню), получить вескриптор Pop-Up меню одним из многих способов (LoadMenu(), GetSubMenu(), CreateMenu(), и т.д.) и выполнить следующий код:
- Подробности
- Родительская категория: Windows
- Категория: System tray
После добавления иконки на Tray можно менять саму иконку, ToolTip и сообщение, посылаемое окну. Для этого необходимо заполнить экземпляр структуры NOTIFYICONDATA и вызвать функцию Shell_NotifyIcon() с параметром NIM_MODIFY и указателем на заполненный экземпляр структуры. При изменении иконки необходимо заполнить поля cbSize, hWnd, uID, uFlags и поля, отвечающие за параметры иконки, которые вы хотите менять. При этом uFlags должен содержать комбинацию флагов, описывающую поля, которые необходимо модифицировать.
- Подробности
- Родительская категория: Windows
- Категория: System tray
Убираем часы:
Code: |
procedure TForm1.Button1Click(Sender: TObject); var hn: HWnd; begin hn := FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'TrayNotifyWnd', nil), 0, 'TrayClockWClass', nil); if hn <> 0 then ShowWindow(hn, SW_HIDE); //Bye,bye,Baby end; |
- Подробности
- Родительская категория: Windows
- Категория: System tray
Данный код сперва конвертирует Ваш текст в DIB, а затем DIB в иконку и далее в ресурс. После этого изображение иконки отображается в System Tray.
Вызов просходит следующим образом....
StringToIcon('This Is Made By Ruslan K. Abu Zant');
N.B>> Не забудьте удалить объект HIcon, после вызова функции...
- Подробности
- Родительская категория: Windows
- Категория: System tray
Для удаления иконки вы должны знать ее ID и дескриптор окна-обработчика сообщений. Для удаления иконки с Tray надо вызвать функцию Shell_NotifyIcon() с параметром NIM_DELETE и указателем на экземпляр структуры NOTIFYICONDATA, у которого должны быть заполнены следующие поля: cbSize, hWnd, uID.
- Подробности
- Родительская категория: Windows
- Категория: System tray
В Windows 2000, формат структуры NotifyIconData, которая используется для работы с иконками в Трее (которая, кстати, называется "The Taskbar Notification Area" :) значительно отличается от предыдущий версий Windows. Однако, эти изменения НЕ отражены в юните ShellAPI.pas в Delphi 5.
- Подробности
- Родительская категория: Windows
- Категория: System tray
При добавлении иконки на Tray вы указывали окно - обработчик сообщения и сообщение (CallbackMessage). Теперь окно, указанное вами будет при любых событиях мыши, происходящих над иконкой получать сообщение, указанное при добавлении иконки. При этом параметры lParam и wParam будут задействованы следующим образом:
(UINT)wParam - содержит ID иконки, над которой произошло
событие
(UINT)lParam - содержит стандартное событие мыши, такое
как WM_MOUSEMOVE или WM_LBUTTONDOWN.
При этом, информация о клавишах смены регистра, так же как и местоположения события, передаваемые при стандартных " настоящих" сообщениях мыши, теряются. Hо положение курсора можно узнать функцией GetCursorPos(), а состояние клавиш смены регистра - функцией GetKeyState(), описанных в winuser.h.
- Подробности
- Родительская категория: Windows
- Категория: System tray
Проще всего использовать RxTrayIcon компонент из библиотеки RxLib
- Подробности
- Родительская категория: Windows
- Категория: System tray
При следующем обновлении часов надпись исчезнет. Так что можно делать это по таймеру.
- Подробности
- Родительская категория: Windows
- Категория: System tray
Страница 1 из 2