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
Автор: Krid
Программный код, который вы предоставили, - это простое реализация иконки часов в Delphi, отображающая текущую дату и время. Часы обновляются каждую секунду с помощью таймера.
Вот несколько предложений по улучшению кода:
Используйте константы вместо магических чисел: Вместо того, чтобы закодировать значения, такие как 1000 (которое представляет 1 секунду) или SM_CXDLGFRAME, определите константы в верхней части вашего файла.
Извлекайте методы и процедуры: Код довольно плотный, что делает его трудным для чтения. Рассмотрите извлечение более мелких методов и процедур, чтобы сделать код более модульным и понятным.
Используйте лучше имена переменных: Некоторые имена переменных, такие как r или pt, не очень описательны. Рассмотрите использование более значимых имен, которые указывают на то, что каждая переменная представляет собой.
Обрабатывайте ошибки более надежно: Код использует Halt(1) в нескольких местах для выхода из программы, если что-то пошло не так. Это не является хорошей практикой, потому что это может сделать отладку трудной. Вместо этого рассмотрите использование более надежных механизмов обработки ошибок.
Рассмотрите использование отдельного потока для обновления часов: Если вы хотите обновлять часы каждую секунду, вам может быть полезно создать отдельный поток для выполнения этого действия. Это может помочь предотвратить блокировку основного потока и улучшить отзывчивость.
В отношении вашего комментария о подклассировании TrayClockWClass, это хороший пункт! Подклассирование системной часовой классы может обеспечить более гибкость и контроль над ее поведением. Однако, этот подход требует болееadvanced знаний в области программирования Windows и может быть более сложным для реализации.
В целом, код, который вы предоставили, - это хороший старт для создания простой часовой иконки в Delphi. С некоторым рефакторингом и улучшениями он может стать еще более robust и пользовательски friendly.
Мы создаем свои часы в трее Delphi при помощи класса TrayNotifyWnd.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал