Создание модальных системных окон в Delphi: блокировка системы и работа с рабочими столами

Delphi , Синтаксис , Справочник по API-функциям

Вопрос создания модального системного окна в Delphi для блокировки системы до ввода определенных значений является актуальным для разработчиков, сталкивающихся с необходимостью ограничения взаимодействия пользователя с рабочим столом. Такая задача может быть решена с помощью создания нового рабочего стола и переключения на него, что позволит отобразить форму в изолированном режиме.

Контекст задачи

Пользователь столкнулся с проблемой создания модального окна, которое блокирует всю систему до ввода определенных значений. В качестве эксперимента было решено использовать создание рабочих столов и переключение между ними. Создание и переключение на новый рабочий стол, а также возвращение на исходный рабочий стол, работают корректно. Однако, при попытке создания формы в новом потоке, форма не отображается, и приложение остается на созданном пустом рабочем столе, блокируя экран до перезагрузки системы.

Оригинальный код

Код, представленный в вопросе, основан на примере из блога Devexpress. В нем используется создание нового потока для отображения формы на новом рабочем столе. В Delphi была предпринята попытка "перевести" данный код, но она не увенчалась успехом.

Анализ проблемы

Проблема кроется в том, что VCL (Visual Component Library) в Delphi не предназначен для создания форм в потоках, отличных от главного потока GUI. Создание форм в таких потоках приведет к ошибкам, так как VCL не является потокобезопасным.

Подтвержденный ответ

Для решения данной задачи необходимо использоватьraw Win32 API функции, такие как RegisterClass и CreateWindow, вместо использования VCL. Также необходимо запустить цикл обработки сообщений в новом потоке для поддержания жизни созданных окон.

Альтернативное решение

В качестве альтернативы можно использовать создание нового процесса и коммуникацию между процессами с помощью IPC (Inter-Process Communication), например, с использованием именованных каналов.

Пример кода на Object Pascal

unit Utils;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADODB, Grids, DBGrids, ExtCtrls, ComCtrls, SyncObjs, ShellApi,
  AddTimeU;

type
  TFormThread = class(TThread)
  private
    FDesktopName: string;
    FFormClassName: string;
    FMessageOnly: Boolean;
    FShowWindowCmd: Word;
  protected
    procedure Execute; override;
  public
    constructor Create(ADesktopName, AFormClassName: string; AMessageOnly, AShowWindowCmd: Word);
  end;

implementation

constructor TFormThread.Create(ADesktopName, AFormClassName: string; AMessageOnly, AShowWindowCmd: Word);
begin
  FreeOnTerminate := True;
  inherited Create(False);
  FDesktopName := ADesktopName;
  FFormClassName := AFormClassName;
  FMessageOnly := AMessageOnly;
  FShowWindowCmd := AShowWindowCmd;
end;

procedure TFormThread.Execute;
var
  hDeskOld, hDeskNew: HDESK;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  WndClass: TWndClass;
  FormHWND: HWND;
begin
  hDeskOld := GetThreadDesktop(GetCurrentThreadId);
  hDeskNew := CreateDesktop(PWideChar(FDesktopName), nil, nil, 0, GENERIC_ALL, nil);
  SwitchDesktop(hDeskNew);
  SetThreadDesktop(hDeskNew);

  // Создание класса окна
  with WndClass do
  begin
    style := CS_OWNDC or CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc := @WindowProc;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := HInstance;
    hCursor := LoadCursor(0, IDC_ARROW);
    hbrBackground := GetStockObject(WHITE_BRUSH);
    lpszMenuName := nil;
    lpszClassName := PWideChar(FFormClassName);
    hIcon := LoadIcon(0, IDI_APPLICATION);
  end;
  RegisterClass(WndClass);

  // Создание окна
  FormHWND := CreateWindowEx(0, PWideChar(FFormClassName), PWideChar(FFormClassName),
    WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
    0, 0, 0, 0);
  if not Assigned(FormHWND) then
    raise Exception.Create('Окно не создано');

  // Показать окно
  ShowWindow(FormHWND, FShowWindowCmd);
  UpdateWindow(FormHWND);

  // Запуск цикла обработки сообщений
  if not FMessageOnly then
  begin
    with StartupInfo do
    begin
      cb := SizeOf(TStartupInfo);
      dwFlags := STARTF_USESHOWWINDOW;
      wShowWindow := SW_SHOWDEFAULT;
    end;
    if not CreateThread(nil, 0, @MessageLoop, FormHWND, 0, nil) then
      raise Exception.Create('Не удалось запустить цикл сообщений');
  end;

  // Возврат на исходный рабочий стол
  SwitchDesktop(hDeskOld);
  CloseDesktop(hDeskNew);
end;

// Функция MessageLoop должна быть реализована отдельно

Заключение

Для создания модального системного окна, блокирующего систему, необходимо использовать Win32 API для создания окна в новом потоке и запуска цикла обработки сообщений. Это позволит отобразить форму на изолированном рабочем столе, не влияя на основное приложение.

Создано по материалам из источника по ссылке.

Создание модального системного окна в Delphi для блокировки рабочего стола и работы с ним в изолированном режиме.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Справочник по API-функциям ::