Отправляет email-рассылки с помощью сервиса Sendsay

Советы по Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Ноябрь 2001   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Автор
Сергей

Статистика

13.545 подписчиков
-22 за неделю
←   Все выпуски   →

Советы по Delphi


Служба Рассылок Subscribe.Ru

Здравствуйте, уважаемые подписчики! Речь сегодня опять пойдет о резидентных программах. В этот раз в программу будут добавлены новые функции, а именно: записная книжка, "усыпление" компьютера, вызов диалога "Завершение работы 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;
      end;
      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.


Полезные мелочи
ExtractFilePath(ParamStr(0)) возвращает каталог, из которого была запущена программа. ParamStr(0) возвращает полное имя файла с программой, а ExtractFilePath выделяет путь к файлу. Пример:
procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Caption := ExtractFilePath(ParamStr(0)) + 'data.txt';
end;


Ошибка
В предыдущем выпуске рассылки была допущена ошибка. При вызове всплывающего меню в качестве координаты y была указана координата x. Вместо
TrackPopupMenu(menu, TPM_LEFTALIGN, p.x, p.x, 0, wnd, nil);
должно быть
 TrackPopupMenu(menu, TPM_LEFTALIGN, p.x, p.y, 0, wnd, nil);


Все советы и замечания, пожалуйста, присылайте на delphi4all@narod.ru

Всего доброго,
Даниил Карапетян.

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное