Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Резидентная программа

- Как бы вы поступили, если бы случайно оказались в одной камере с Гитлером, Саддамом Хусейном и Билли Гейтсом, и у вас, случайно, оказался с собой пистолет и два патрона?
- Сначала два раза выстрелил бы в Гейтса, а потом рукояткой его, рукояткой.

Программу без использования 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.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.