Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.134.78.106] |
|
Сообщ.
#1
,
|
|
|
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. При следующем обновлении часов надпись исчезнет. Так что можно делать это по таймеру. |
Сообщ.
#2
,
|
|
|
Можно сделать и свои часики:
uses windows, messages, ShellAPI; const ClassName = 'MyClockWndClass'; CWM_DESTROY = $101; CWM_DTCPL = $102; 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); SetLength(Result, lstrlen(@result[1])) 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); SetLength(result, lstrlen(@result[1])) 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,CWM_DESTROY,'Exit'); Insertmenu(hm,0,MF_BYPOSITION or MF_SEPARATOR,0,nil); Insertmenu(hm,0,MF_BYPOSITION or MF_STRING,CWM_DTCPL,'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 CWM_DESTROY : SendMessage(wnd,wm_destroy,0,0); CWM_DTCPL : 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; procedure WinMain; begin InitInstance; InitApplication; InitWindow; MsgLoop end; begin WinMain end. но правильнее было бы внедриться в Explorer и сабклассировать TrayClockWClass. Автор: Krid |