Надпись на часах в трее , Решил я подурачиться... ;)

[drinkOut]

uses
  Windows, Messages, Dialogs;
var
  hTaskbar  : HWND;
  hTrayClock: HWND;
begin
  hTaskbar := FindWindow('Shell_TrayWnd', nil);
  hTrayClock := FindWindowEx(hTaskbar, 0, 'TrayClockWClass', nil);
  SetWindowText(hTrayClock, '>:-(');
  SendMessage(hTrayClock, WM_MOUSEMOVE, 0, 0);
end.

По всем моим подсчётам этот код должен менять надпись на часиках, но видать я где-то просчитался, поскольку этот код на самом деле нифига не меняет.

Не пойму, в чём причина?

[volvo877]

Вот так, если я не ошибаюсь...

hTaskBar := FindWindow('Shell_TrayWnd', nil);
hTrayNotify := FindWindowEx(hTaskBar, 0, 'TrayNotifyWnd', nil);
hTrayClock := FindWindowEx(hTrayNotify, 0, 'TrayClockWClass', nil);
...

[drinkOut]

volvo877, так действительно правильней (я осознал), но, к сожалению, этот код тоже не даёт желаемого результата.

uses
  Windows, Messages, Dialogs;
var
  hTaskbar    : HWND;
  hTrayNotify : HWND;
  hTrayClock  : HWND;
begin
  hTaskBar := FindWindow('Shell_TrayWnd', nil);
  hTrayNotify := FindWindowEx(hTaskBar, 0, 'TrayNotifyWnd', nil);
  hTrayClock := FindWindowEx(hTrayNotify, 0, 'TrayClockWClass', nil);
  SetWindowText(hTrayClock, '>:-(');
  SendMessage(hTrayClock, WM_MOUSEMOVE, 0, 0);
end.

Сообщение отредактировано: drinkOut - 25.06.05, 20:38

[Krid]

var
  hTrayClock  : HWND;
  DC:HDC;
  r:TRect;
begin
  hTrayClock := FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'TrayNotifyWnd',nil),0,'TrayClockWClass',nil);
  GetWindowRect(hTrayClock,r);
  DC := GetDC(0);
//  SetBkMode(DC, TRANSPARENT);   // можешь сделать прозрачный фон
  SetTextColor(DC, RGB($0FF,0,0));
  SetBkColor(DC,RGB($0FF,$0FF,0));
  TextOut(DC, r.Left+((r.Right-r.Left) div 4), r.Top+((r.Bottom-r.Top) div 4), '>:-(', 4);
  ReleaseDC(hTrayClock, DC);
end.

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

[Alex Forth]

А как свое окошко в трей внедрить?

[Krid]

system tray

[drinkOut]

Ясно
Походу дела надпись на часиках - это не текст контрола, а графический вывод, вот и SetWindowText() естесно не подошёл, приходиться самим перерисовывать.

Inc(Krid.Rating);

[Alex Forth]

Цитата Krid @ 26.06.05, 08:02

system tray

Иконку я и так знаю как туда засунуть. А вот как сделать в трее свое окошко, подобное тем же часам???

[Krid]

Например так

uses
  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.

exe в аттаче.
Прикреплённый файлp1.zip (8.76 Кбайт, скачиваний: 24)

[drinkOut]

Браво,Krid!

[drinkOut]

Внимание, прикол!
У меня Agnitum Tauscan посчитал эту прогу трояном!
Прикреплённый файлTau.JPG (15.71 Кбайт, скачиваний: 523)

[Krid]

Скорее всего из-за

FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'TrayNotifyWnd',nil),0,'TrayClockWClass',nil);

вроде все остальное безобидно.

[drinkOut]

Krid,
FindWindowEx(...) тут не причём - я только что проверил.

[Rouse_]

Хм... / говоря в сторону / а я бы сделал в соответствии с MSDN и реализовал бы свой интерфейс на основе IDescBand

[Krid]

Цитата drinkOut @ 26.06.05, 15:16

FindWindowEx(...) тут не причём - я только что проверил.

Понятно. Я просто подумал, что ему не понравилась именно попытка найти окно TrayClockWClass. Вобщем, выкинь ты этот Tauscan

Цитата Rouse_ @ 26.06.05, 16:12

а я бы сделал в соответствии с MSDN и реализовал бы свой интерфейс на основе IDescBand

Да, но это если бы надо было встроить свою панельку в таскбар. А для встраивания окон в трей, увы, интерфейсов не сделали. Так что тут все по-старинке

Кстати, более удобный вариант заменить часы в трее - внедриться в explorer и сделать сабклассинг TrayClockWClass.