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

Автор: Даниил Карапетян
WEB сайт: http://program.dax.ru

Занимаются любовью хакер и эпилептичка, тут у нее приступ эпилепсии ну а он думает о как ей хорошо, ну он закончил, а она все еще в приступе ну он говорит эй ты чего а она ноль внимания - у нее приступ. Тогда он звонит 03 и говорит у меня тут проблема , а его спрашивают в чем дело на что он отвечает Да по моему оргазм завис...

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