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

Речь сегодня опять пойдет о резидентных программах. В этот раз в программу будут добавлены новые функции, а именно: записная книжка, "усыпление" компьютера, вызов диалога "Завершение работы Windows". Для тех, кто не читал предыдущего выпуска: чтобы создать программу без модулей (а это здесь нужно) можно в меню File | New... выбрать Console Application.

Начиная с этого выпуска, я буду выкладывать на сайт program.dax.ru все файлы проекта, необходимые для компиляции. Скачав их (в архиве они будут занимать 3-5 Кбайт), Вам не придется думать, что делать с этим текстом и какие компоненты с какими событиями создавать.

Записная книжка - это окно с многострочным полем ввода, которое легко вызывается и которое сохраняет текст, вводимый пользователем. То есть, при открытии текст считывается из файла, а при закрытии сохраняется в файл. Поскольку поле ввода - окно, его можно создать без каких-либо родительских окон. В VCL аналогом этого было бы создание Memo вне формы. Чтобы объяснить Windows, что это поле ввода, в качестве имени класса окна нужно указать 'EDIT'. ES_MULTILINE делает его многострочным. Когда записная книжка закрывается, текст из нее нужно сохранить. Но сообщения WM_CLOSE, WM_DESTROY и другие попадают не ко мне, а в стандартную оконную процедуру поля ввода. Поэтому стандартную процедуру поля ввода нужно заменить на свою. А чтобы сохранить функциональность поля ввода, все сообщения кроме WM_DESTROY пересылаются в старую оконную процедуру.

В прошлом выпуске программа отслеживала координаты курсора и, если мышь была в левом верхнем углу экрана, запускала ScreenSaver. Чтобы при следующей проверке координат курсора не запускать ScreenSaver повторно, программа проверяла, какое окно сейчас активно. Дело в том, что стандартные хранители экрана в некоторых версиях Windows всегда создают окна с названием класса 'WindowsScreenSaverClass'. Но, поскольку работает это не всюду, я решил убрать эту функцию.

program
 Project1;
uses

  Windows,
  ShellAPI,
  Messages;

const

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

  menu: hMenu; // Всплывающее меню
  mywnd: hWnd; // Окно программы
  memo: hWnd = 0; // Окно записной книжки
  OldMemoProc: Pointer; // Стандартная оконная процедура Edit

// Оконная процедура записной книжки:
function
 MemoWndProc(wnd: hWnd; msg, wParam,
  lParam: longint): longint; stdcall
;
var

  s: PChar;
  len: integer;
  F: File
;
begin

  case
 msg of

    WM_DESTROY: begin
 // Окно закрывается
      // Сохранение текста:
      len := GetWindowTextLength(memo);
      GetMem(s, len + 1);
      GetWindowText(memo, s, len + 1);
      AssignFile(F, 'memo.txt');
      Rewrite(F, 1);
      BlockWrite(F, s^, len);
      CloseFile(F);
      FreeMem(s);
      result := 0;
      memo := 0;
    end
;
    WM_KEYUP: begin
 // Нажата клавиша
      if
 wparam = VK_ESCAPE // Нажат Escape
        then
 result := SendMessage(memo, WM_CLOSE, 0, 0)
        else
 result := DefWindowProc(wnd, msg, wparam, lparam);
    end
;
    // Иначе - вызвать старую оконную процедуру
    else
 result := CallWindowProc(OldMemoProc, wnd, msg, wparam, lparam);
  end
;
end
;

// Создание окна записной книжки:
procedure
 CreateMemo;
var

  len: cardinal;
  F: hFile;
  s: PChar;
  ReadBytes: cardinal;
begin

  // Если записная книжка уже открыта - выход из процедуры:
  if
 GetForegroundWindow = memo then
 Exit;
  // Создание окна:
  memo := CreateWindowEx(WS_EX_PALETTEWINDOW, 'EDIT', nil
,
    WS_POPUP or
 WS_SIZEBOX or
 WS_VSCROLL or

    ES_MULTILINE or
 ES_AUTOVSCROLL,
    GetSystemMetrics(SM_CXFULLSCREEN) div
 2 - 200,
    GetSystemMetrics(SM_CYFULLSCREEN) div
 2 - 200,
    400, 400, 0, 0, hinstance, nil
);
  // Установка шрифта:
  SendMessage(memo, WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT), 0);
  // Сохранение старой и установка новой оконной процедуры:
  OldMemoProc := Pointer(GetWindowLong(memo, GWL_WNDPROC));
  SetWindowLong(memo, GWL_WNDPROC, longint(@MemoWndProc));
  { Открытие файла (здесь удобнее воспользоваться функциями WinAPI): }
  try

    F := CreateFile('memo.txt', GENERIC_READ, FILE_SHARE_READ, nil
,
      OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    if
 F = INVALID_HANDLE_VALUE then
 Exit;
    len := GetFileSize(F, nil
);
    if
 len = $FFFFFFFF then
 Exit;
    GetMem(s, len + 1);
    ReadFile(F, s^, len, ReadBytes, nil
);
    SetWindowText(memo, s);
    CloseHandle(F);
    FreeMem(s);
  except
 SetWindowText(memo, 'Error') end
;
  // Показать окно:
  ShowWindow(memo, SW_SHOW);
  UpdateWindow(memo);
end
;

// Главная оконная процедура:
function
 MyWndProc(wnd: hWnd; msg, wParam,
  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: CreateMemo;
        1: SendMessage(mywnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
        2: SetSystemPowerState(true
, true
);
        4: SendMessage(mywnd, WM_CLOSE, 0, 0);
      end
;
      result := 0;
    end
;
    WM_HOTKEY: begin
 // Нажата горячая клавиша
      case
 loword(lparam) of

        // Нажата клавиша Pause:
        0: SendMessage(wnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
        // Нажаты клавиши Alt+Pause:
        MOD_ALT: begin

          ProgmanWnd := FindWindow('Progman', 'Program Manager');
          if
 ProgmanWnd <> 0
            then
 SendMessage(ProgmanWnd, WM_CLOSE, 0, 0);
        end
;
        // Нажаты клавиши Alt+Shift+Pause:
        MOD_ALT or
 MOD_SHIFT: SetSystemPowerState(true
, true
);
        // Иначе:
        else
 CreateMemo;
            result := 0;
    end
;
    WM_ACTIVATEAPP: begin
 // Изменение активности приложения
      { Если приложение потеряло активность - закрыть (если нужно)
      записную книжку: }
      if
 (memo <> 0) and
 (wparam = 0)
        then
 SendMessage(memo, WM_CLOSE, 0, 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 := 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,
    'My Window', WS_POPUP, 100, 100, 200, 200, 0, 0, hInstance, nil
);
  if
 result = 0 then
 halt(0);
end
;

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

// Создание всплывающего меню:
function
 CreateMyMenu: hMenu;
begin

  result := CreatePopupMenu;
  if
 result = 0 then
 Exit;
  AppendMenu(result, MF_STRING, 0, 'Memo');
  AppendMenu(result, MF_STRING, 1, 'ScreenSaver');
  AppendMenu(result, MF_STRING, 2, 'Sleep');
  AppendMenu(result, MF_SEPARATOR, 3, 'Exit');
  AppendMenu(result, MF_STRING, 4, 'Exit');
end
;

var

  msg: TMsg;
begin

  mywnd := CreateMyWnd; // Создание окна
  CreateTray; // Создание tray
  menu := CreateMyMenu; // Создание меню
  // Установка низкого приоритета:
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_IDLE);
  // Регистрация "горячих клавиш":
  RegisterHotKey(mywnd, 0, 0, VK_PAUSE);
  RegisterHotKey(mywnd, 1, MOD_ALT, VK_PAUSE);
  RegisterHotKey(mywnd, 2, MOD_SHIFT, VK_PAUSE);
  RegisterHotKey(mywnd, 3, MOD_ALT or
 MOD_SHIFT, VK_PAUSE);

  // Распределение сообщений:
  while
 (GetMessage(msg, 0, 0, 0)) do
 begin

    TranslateMessage(msg);
    DispatchMessage(msg);
  end
;

  // "Уничтожение" горячих клавиш:
  UnregisterHotKey(mywnd, 0);
  UnregisterHotKey(mywnd, 1);
  UnregisterHotKey(mywnd, 2);
end
.

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

• Delphi 7 ToolsAPI
• Что такое порт, правила для работы с портами
• Программирование на основе Win32 API в Delphi