VPF::Замена часов в трейе - Форум программистов

navodri

Дата 22.8.2010, 14:57 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 173
Регистрация: 26.10.2007

Репутация: нет
Всего: -1

Пытаюсь заменить часы в трейе. Этот код работает под ХР, но не хочет работать в Windows 7. В последнем варианте создается впечатление, что моя программа оказывается позади часов Windows.
Как заставить код работать в семерке/висте ?

Код


program prog;
 
uses
  windows, messages, ShellAPI;
 
const
 ClassName = 'TTrayClockWndClass';
 
var
 AppWinClass: TWndClass;
 mMessage:TMsg;
 hTrayClock, Window: hWnd;
 idTM: Integer;
 
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;
 
begin
 with AppWinClass do
  begin
   style:= CS_VREDRAW or CS_HREDRAW;
   lpfnWndProc:= @AppWndProc;
   cbClsExtra:= 0;
   cbWndExtra:= 0;
   hInstance:= hInstance;
   hIcon:= LoadIcon(hInstance, IDI_APPLICATION);
   hCursor:= LoadCursor(hInstance,IDC_ARROW);
   hbrBackground:= GetStockObject(BLACK_BRUSH);
   lpszMenuName:= nil;
   lpszClassName:= ClassName;
  end;
 if RegisterClass(AppWinClass)=0 then Halt(1);
 
 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;
 
 idTM:=SetTimer(Window,1,1000,@TimerProc);
 ShowWindow(Window, SW_SHOWNORMAL);
 UpdateWindow(Window);
 InvalidateRect(Window,nil,True);
 
 while GetMessage(mMessage, 0, 0, 0) do
    begin
      TranslateMessage(mMessage);
      DispatchMessage(mMessage);
    end;
  Halt(mMessage.wParam)
 
 
end.

drkot

Дата 24.8.2010, 00:52 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8

Возможно Вы рисуете не на том окне

--------------------

Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.

navodri

Дата 24.8.2010, 12:02 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 173
Регистрация: 26.10.2007

Репутация: нет
Всего: -1

Да вроде правильно. Смотрите:

Код


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

Misha_White

Дата 15.7.2011, 08:48 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 207
Регистрация: 25.4.2007
Где: Кодинск

Репутация: нет
Всего: 1

Есть решение?

--------------------

Я не волшебник... я только учусь...

KAMIKAZE

Дата 2.8.2011, 12:56 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 88
Регистрация: 17.1.2007

Репутация: нет
Всего: нет

Поддерживаю.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »