Получить или установить допустимые периоды истечения времени

Delphi , Синтаксис , Дата и Время

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
  Retrieves information about the time-out period associated 
  with the accessibility features. 
  The pvParam parameter must point to an ACCESSTIMEOUT 
  structure that receives the information. 
  Set the cbSize member of this structure and the 
  uiParam parameter to SizeOf(ACCESSTIMEOUT). 
}

 { 
  Ermittelt die maximale Zeit wo der Benutzer keine Eingaben macht bei den 
  Eingabehilfen. "uiParam" muss die Gro?e der Struktur 
  ACCESSTIMEOUT sein und "pvParam" muss eine ACCESSTIMEOUT-Struktur 
  ubergeben werden, die gefullt wird. 
}

 // ACCESSTIMEOUT structure 
type
   TAccessTimeOut = record
     cbSize: UINT;
     dwFlags: DWORD;
     iTimeOutMSec: DWORD;
   end;

 procedure GetAccessTimeOut(var bTimeOut: Boolean; var bFeedBack: Boolean;
   var iTimeOutTime: Integer);
   // bTimeOut: the time-out period for accessibility features. 
  // bFeedBack: the operating system plays a descending 
  //            siren sound when the time-out period elapses and the 
  //            Accessibility features are turned off. 
  // iTimeOutTime: Timeout in ms 
var
   AccessTimeOut: TAccessTimeOut;
 begin
   ZeroMemory(@AccessTimeOut, SizeOf(TAccessTimeOut));
   AccessTimeOut.cbSize := SizeOf(TAccessTimeOut);

   SystemParametersInfo(SPI_GETACCESSTIMEOUT, SizeOf(AccessTimeOut), @AccessTimeOut, 0);

   bTimeOut := (AccessTimeOut.dwFlags and ATF_TIMEOUTON) = ATF_TIMEOUTON;
   bFeedBack := (AccessTimeOut.dwFlags and ATF_ONOFFFEEDBACK) = ATF_ONOFFFEEDBACK;
   iTimeOutTime := AccessTimeOut.iTimeOutMSec;
 end;

 // Test it: 

procedure TForm1.Button2Click(Sender: TObject);
 var
   bTimeOut, bFeedBack: Boolean;
   iTimeOutTime: Integer;
 begin
   GetAccessTimeOut(bTimeOut, bFeedBack, iTimeOutTime);
   label1.Caption := IntToStr(Ord(bTimeOut));
   Label2.Caption := IntToStr(Ord(bFeedBack));
   Label3.Caption := IntToStr(iTimeOutTime);
 end;

 { 
  Sets the time-out period associated with the accessibility features. 
  The pvParam parameter must point to anACCESSTIMEOUT structure that 
  contains the new parameters. 
  Set the cbSize member of this structure and the uiParam 
  parameter to sizeof(ACCESSTIMEOUT). 
}

 { 
  Setzt Informationen zu den ACCESSEDTIMEOUT-Eigenschaften. 
  "uiParam" erwartet die Gro?e der ACCESSEDTIMEOUT-Struktur, 
  die in "pvParam" ubergeben werden muss. 
}

 procedure SetAccessTimeOut(bTimeOut, bFeedBack: Boolean; iTimeOutTime: Integer);
   // bTimeOut: If true, a time-out period has been set for accessibility features. 
  // bFeedBack: If true, the operating system plays a descending 
  //                    siren sound when the time-out period elapses and the 
  //                    accessibility features are turned off. 
  // iTimeOutTime: Timeout in ms 
var
   AccessTimeOut: TAccessTimeOut;
 begin
   ZeroMemory(@AccessTimeOut, SizeOf(TAccessTimeOut));
   AccessTimeOut.cbSize := SizeOf(TAccessTimeOut);

   case bTimeOut of
     True: AccessTimeOut.dwFlags  := ATF_TIMEOUTON;
     False: AccessTimeOut.dwFlags := 0;
   end;

   if bFeedBack then
     AccessTimeOut.dwFlags := AccessTimeOut.dwFlags or ATF_ONOFFFEEDBACK;

   AccessTimeOut.iTimeOutMSec := iTimeOutTime;

   SystemParametersInfo(SPI_SETACCESSTIMEOUT, SizeOf(AccessTimeOut),
     @AccessTimeOut, SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
 end;

 // Test it: 
procedure TForm1.Button1Click(Sender: TObject);
 begin
   SetAccessTimeOut(True, True, 600000); // 10 min. timeout 
end;

Программный код, используемый для получения и установки периода ожидания, связанного с функциями доступности в Windows. Он использует функцию SystemParametersInfo для извлечения или изменения периода ожидания.

Процедура GetAccessTimeOut получает информацию о текущем периоде ожидания, включая возможность включения периода ожидания и игнорирование звукового сигнала при истечении периода ожидания, а также длину периода ожидания в миллисекундах. Процедура SetAccessTimeOut устанавливает эти параметры.

Вот подробное описание того, что код делает:

1. Процедура GetAccessTimeOut:

   • Создает структуру ACCESSTIMEOUT и инициализирует ее размер к правильному значению.
   • Вызывает функцию SystemParametersInfo с действием SPI_GETACCESSTIMEOUT для извлечения текущих параметров периода ожидания.
   • Извлекает значения из возвращенной структуры и присваивает их локальным переменным (bTimeOut, bFeedBack и iTimeOutTime).
   • Присваивает эти значения глобальным переменным.

2. Процедура SetAccessTimeOut:

   • Создает структуру ACCESSTIMEOUT и инициализирует ее размер к правильному значению.
   • Устанавливает член dwFlags структуры на основе входных параметров (bTimeOut и bFeedBack).
   • Устанавливает член iTimeOutMSec структуры на значение input (iTimeOutTime).
   • Вызывает функцию SystemParametersInfo с действием SPI_SETACCESSTIMEOUT для установки новых параметров периода ожидания.
   • Флаги SPIF_UPDATEINIFILE и SPIF_SENDWININICHANGE указывают, что изменения должны быть сохранены после перезапуска системы и отправлены всем запущенным приложениям.

Код также включает в себя тестовые процедуры (Button2Click и Button1Click), которые извлекают текущие параметры периода ожидания и отображают их на форме, а также устанавливают период ожидания в 10 минут с звуковым сигналом.

Альтернативное решение с использованием встроенной функции Delphi GetSystemMetrics:

function GetTimeout: Integer;
begin
  Result := GetSystemMetrics(SM_ACCESS_TIMEOUT);
end;

procedure SetTimeout(aTimeout: Integer; aFeedback: Boolean);
var
  SPI: TSPInformation;
begin
  SPI.cbSize := sizeof(TSPInformation);
  SPI.uAction := SPI_SETACCESSTIMEOUT;
  SPI.dwParam := aTimeout;
  if aFeedback then
    SPI.dwParam := SPI.dwParam or ATF_ONOFFFEEDBACK;
  SystemParametersInfo(SPI);
end;

Это решение более компактно и легко использовать, но может не обеспечивать такой же уровень контроля, как оригинальный код.

Получить или установить допустимые периоды истечения времени для функций доступности Windows, а также настроить звуковую обратную связь при истечении таймаута.

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

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

:: Главная :: Дата и Время ::