Резидентная программа

Программу без использования VCL (Visual Component Library). Иначе это можно назвать "написанием программ на WinAPI". Один из способов создать такой проект в Delphi - в меню File | New... выбрать Console Application и удалить строку {$APPTYPE CONSOLE}.

Почти для любого действия нам понадобится окно. Но видеть нам его не нужно. Поэтому, создадим невидимое окно. Для этого нужно зарегистрировать класс окна и создать его, но не показывать. Эти два действия происходят в функции CreateMyWnd. Чтобы было возможно общение пользователя с программой, можно сделать TrayIcon (иконку справа на панели задач). Она создается в процедуре CreateTray. Иконку я взял, наверное, не самую подходящую, но это для примера. Точно так же можно взять собственную иконку. Для tray также нужно всплывающее меню. Здесь оно создается в функции CreateMyMenu и состоит всего из одного пункта. Резидентные программы обычно отслеживают что-то. Для этой цели бывает необходим таймер. Создается он при помощи SetTimer. Чтобы наша программа не "тормозила" компьютер, приоритет программы лучше всего установить в самый низкий. Конечно, это хорошо не во всех случаях, но иногда это весьма полезно. Эта программа занимается тем, что запускает ScreenSaver при сдвиге курсора в левый верхний угол (координаты курсора проверяются каждую секунду) и при нажатии клавиши Pause (реализуются через HotKey). Задача, конечно, не самая актуальная. Присылайте, пожалуйста, ваши идеи по поводу задач для резидентной программы.

program
 MyResident;
uses

  Windows,
  ShellAPI,
  Messages;

const

  ClassName = 'MyResident'; { Имя класса }
  WM_NOTIFYTRAYICON = WM_USER + 1; { Это сообщение будет
    генерироваться при событиях с tray }

var

  menu: hMenu; { Всплывающее меню }
  mywnd: hWnd; { Окно программы }

function
 MyWndProc(wnd: hWnd; msg, wParam,
  lParam: longint): longint; stdcall
;
var

  p: TPoint;
  s: array
 [0..255] of
 char;
  tray: TNotifyIconData;
begin

  case
 msg of

    WM_TIMER: begin
 { Событие таймера }
      GetCursorPos(p);
      if
 (p.x = 0) and
 (p.y = 0) then
 begin
 { Проверка координат курсора }
        { Если ScreenSaver еще не запущен - запустить: }
        GetClassName(GetForegroundWindow, s, length(s));
        if
 s <> 'WindowsScreenSaverClass'
          then
 SendMessage(wnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
      end
;
      result := 0;
    end
;
    WM_NOTIFYTRAYICON: begin
 { Событие tray }
      { Если нажата правая кнопка, показать меню: }
      if
 lparam = WM_RBUTTONUP then
 begin

        GetCursorPos(p);
        TrackPopupMenu(menu, TPM_LEFTALIGN, p.x, p.x, 0, wnd, nil
);
      end
;
      result := 0;
    end
;
    WM_COMMAND: begin
 { Выбран пункт меню }
      { Если выбран нулевой пункт (здесь - единственный) -
        закрыть программу: }
      if
 lo(lparam) = 0 then
 SendMessage(mywnd, WM_CLOSE, 0, 0);
      result := 0;
    end
;
    WM_HOTKEY: begin
 { Нажата горячая клавиша }
      { Запуск хранителя экрана: }
      SendMessage(wnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
      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 := 0;
  wc.lpfnWndProc := @MyWndProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := hInstance;
  wc.hIcon := 0;
  wc.hCursor := 0;
  wc.hbrBackground := COLOR_WINDOW;
  wc.lpszMenuName := nil
;
  wc.lpszClassName := ClassName;
  if
 RegisterClass(wc) = 0 then
 halt(0);
  { Создание окна: }
  result := CreateWindowEx(WS_EX_APPWINDOW, ClassName,
    'My Window', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil
);
  if
 result = 0 then
 halt(0);
end
;

procedure
 CreateTray;
var

  tray: TNotifyIconData;
begin

  { Создание tray: }
  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(0, IDI_ASTERISK);
    szTip := ('My Resident');
  end
;
  Shell_NotifyIcon(NIM_ADD, @tray);
end
;

function
 CreateMyMenu: hMenu;
begin

  { Создание меню: }
  result := CreatePopupMenu;
  if
 result = 0 then
 halt(0);
  if
 not
 AppendMenu(result, MF_STRING, 0, 'Exit') then
 halt(0);
end
;

var

  msg: TMsg;

begin

  mywnd := CreateMyWnd; // Создание окна
  CreateTray; // Создание tray
  menu := CreateMyMenu; // Создание меню
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_IDLE); { Установка
    низкого приоритета }
  RegisterHotKey(mywnd, 0, 0, VK_PAUSE); // Регистрация "горячей клавиши"
  SetTimer(mywnd, 0, 1000, nil
); // Создание таймера
  while
 (GetMessage(msg, 0, 0, 0)) do
 begin

    TranslateMessage(msg);
    DispatchMessage(msg);
  end
;
  KillTimer(mywnd, 0); // Уничтожение таймера
  UnregisterHotKey(mywnd, 0); // "Уничтожение" горячей клавиши
end
.

Другое по теме:

• Как консольное приложение может узнать, что Винды завершаются
• Как использовать консоль в не-консольном приложении
• Как захватить весь вывод в консоли