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

Иногда, при потере фокуса, всплывающее меню в System Tray при потере фокуса не закрывается. Поэтому, при обработке сообщений для всплывающего меню необходимо поместить окно на передний план и послать ему сообщение WM_NULL.

Многие программы показывают Pop-Up меню при щелчке на их иконке,  помещенной на Tray, как этого добиться ?

 

Вы  должны  обрабатывать сообщение, указанное вами при добавлении   иконки  на Tray. При значении (UINT)lParam, равном WM_RBUTTONDOWN  (это обычно дял Pop-Up меню по правой кнопке), или любому другому  необходимому   вам,  вы  должны  вызовом  функции  GetCursorPos()  получить  позицию  курсора в момент события (вряд ли пользователь     успеет  убрать  мышь  за время обработки сообщения, особенно если   он ожидает меню), получить вескриптор Pop-Up меню одним из многих  способов  (LoadMenu(),  GetSubMenu(),  CreateMenu(),  и  т.д.)  и    выполнить следующий код:       

 

После добавления иконки на Tray можно менять саму иконку, ToolTip  и  сообщение,  посылаемое  окну.  Для  этого необходимо заполнить  экземпляр     структуры    NOTIFYICONDATA   и   вызвать   функцию  Shell_NotifyIcon()    с   параметром   NIM_MODIFY   и  указателем  на заполненный экземпляр структуры.  При  изменении  иконки  необходимо заполнить поля cbSize, hWnd,   uID,  uFlags  и  поля, отвечающие за параметры иконки, которые вы хотите  менять.  При  этом  uFlags  должен  содержать  комбинацию флагов, описывающую поля, которые необходимо модифицировать.

 

Убираем часы:

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;

 

 

Данный код сперва конвертирует Ваш текст в DIB, а затем DIB в иконку и далее в ресурс. После этого изображение иконки отображается в System Tray.

 Вызов просходит следующим образом....

 StringToIcon('This Is Made By Ruslan K. Abu Zant');

N.B>> Не забудьте удалить объект HIcon, после вызова функции...

 

Для  удаления  иконки  вы  должны  знать  ее  ID  и  дескриптор   окна-обработчика сообщений.   Для    удаления    иконки   с   Tray   надо   вызвать   функцию     Shell_NotifyIcon()   с  параметром  NIM_DELETE  и  указателем  на   экземпляр   структуры  NOTIFYICONDATA,  у  которого  должны  быть  заполнены следующие поля: cbSize, hWnd, uID.

В Windows 2000, формат структуры NotifyIconData, которая используется для работы с иконками в Трее (которая, кстати, называется "The Taskbar Notification Area" :) значительно отличается от предыдущий версий Windows. Однако, эти изменения НЕ отражены в юните ShellAPI.pas в Delphi 5.

 

При  добавлении  иконки  на  Tray вы  указывали окно - обработчик    сообщения  и  сообщение (CallbackMessage). Теперь окно, указанное     вами  будет  при  любых  событиях  мыши, происходящих над иконкой   получать  сообщение,  указанное  при  добавлении иконки. При этом   параметры lParam и wParam будут задействованы следующим образом:

 

       (UINT)wParam   -   содержит ID иконки, над которой произошло

                          событие

       (UINT)lParam   -   содержит стандартное событие мыши, такое

                          как WM_MOUSEMOVE или WM_LBUTTONDOWN.

 

При  этом,  информация  о  клавишах  смены регистра, так же как и     местоположения  события, передаваемые при стандартных " настоящих"     сообщениях мыши, теряются.       Hо  положение  курсора  можно узнать функцией GetCursorPos(), а состояние   клавиш   смены  регистра  -  функцией  GetKeyState(),  описанных в winuser.h.

 

 

Проще всего использовать RxTrayIcon компонент из библиотеки RxLib

При следующем обновлении часов надпись исчезнет. Так что можно делать это по таймеру.