Windows,SysUtils,Shellapi,Messages,Registry
Download 18.85 Kb.
|
Rezident dasturlar yaratish
program ETesterR; uses
Windows,SysUtils,ShellAPI,Messages,Registry; const ClassName = 'ETesterR'; // Имя класса WM_NOTIFYTRAYICON = WM_USER + 1; { Это сообщение будет генерироваться при событиях с tray } var
menu: hMenu; // Всплывающее меню mywnd: hWnd; // Окно программы {$R ETesterR.res} // Главная оконная процедура: procedure SetCurrentETdir; var
h: TRegistry; s:string; i,j,l:integer; begin
h := TRegistry.Create; with h do begin RootKey := HKEY_LOCAL_MACHINE; OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', false); s:=ReadString('EtesterR'); CloseKey; Free;
end; l:=length(s); for i:=l downto 1 do if s[i]='\' then begin j:=i; break end; s:=copy(s,1,j-1); setcurrentdir(s); end;
var h: HWND; begin h := findwindow(nil, 'ETServer'); if h <> 0 then PostMessage(h,wm_quit, 0, 0); end ;
lParam: longint): longint; stdcall; var p: TPoint; tray: TNotifyIconData; ProgmanWnd: hWnd; begin case msg of WM_NOTIFYTRAYICON: begin // Событие tray // Если нажата правая кнопка, показать меню: if lparam = WM_RBUTTONUP then begin SetForegroundWindow(mywnd); GetCursorPos(p); TrackPopupMenu(menu, TPM_LEFTALIGN, p.x, p.x, 0, wnd, nil); end; result := 0; end; WM_COMMAND: begin // Выбран пункт меню { В зависимости от выбранного пункта меню открывается записная книжка, запускается ScreenSaver, "усыпляется" компьютер или закрывается программа: } case loword(wparam) of 0:WinExec(Pchar('ETester.exe'), SW_Restore); 2:begin SendMessage(mywnd, WM_CLOSE, 0, 0);shutdown end; end; result:=0; end; WM_DESTROY: begin // Закрытие программы // Удаление tray: with tray do begin cbSize := sizeof(TNotifyIconData); wnd := mywnd; uID := 0; end;
Shell_NotifyIcon(NIM_DELETE, @tray); PostQuitMessage(0); result := 0; end;
else result := DefWindowProc(wnd, msg, WParam, LParam); end;
end; // Создание окна: function CreateMyWnd: hWnd; var wc: WndClass; begin // Регистрация класса: wc.style := CS_HREDRAW or CS_VREDRAW; wc.lpfnWndProc := @MyWndProc; wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hInstance := hInstance; wc.hIcon := LoadIcon(hinstance, IDI_ASTERISK); wc.hCursor := LoadCursor(hinstance, IDC_ARROW); wc.hbrBackground := COLOR_INACTIVECAPTION; wc.lpszMenuName := nil; wc.lpszClassName := ClassName; if RegisterClass(wc) = 0 then halt(0); // Создание окна: result := CreateWindowEx(WS_EX_APPWINDOW, ClassName, 'ETServerR', WS_POPUP, 100, 100, 200, 200, 0, 0, hInstance, nil); if result = 0 then halt(0); SetCurrentETdir; WinExec(Pchar('ETServer.exe'), SW_Restore); end;
procedure CreateTray; var
tray: TNotifyIconData; begin
with tray do begin cbSize := sizeof(TNotifyIconData); wnd := mywnd; uID := 0; uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; uCallBackMessage := WM_NOTIFYTRAYICON; hIcon := LoadIcon(hInstance,'ETesterR'); szTip := ('ETServerR'); end; Shell_NotifyIcon(NIM_ADD, @tray); end; // Создание всплывающего меню: function CreateMyMenu: hMenu; begin result := CreatePopupMenu; if result = 0 then Exit; AppendMenu(result, MF_STRING, 0, 'Hususiyat'); AppendMenu(result, MF_SEPARATOR,1, 'Exit'); AppendMenu(result, MF_STRING, 2, 'Chiqish'); end;
msg: TMsg; begin mywnd := CreateMyWnd; // Создание окна CreateTray; // Создание tray menu := CreateMyMenu; // Создание меню // Установка низкого приоритета: SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_IDLE); // Распределение сообщений: while (GetMessage(msg, 0, 0, 0)) do begin TranslateMessage(msg); DispatchMessage(msg); end; end. Download 18.85 Kb. Do'stlaringiz bilan baham: |
ma'muriyatiga murojaat qiling