Мы можем использовать функцию MsgWaitForMultipleObjects (или её расширенный вариант MsgWaitForMultipleObjectsEx) для создания функции "sleep с обработкой сообщений" без использования опроса.
function SleepMsg(const dwTimeout: Cardinal): Boolean;
const
MSGF_SLEEPMSG = $5300;
MWMO_WAITANY = $0000;
MWMO_INPUTAVAILABLE = $0004;
var
dwStart, dwElapsed, dwStatus: Cardinal;
Msg: TMsg;
begin
dwStart := GetTickCount;
dwElapsed := 0;
while dwElapsed < dwTimeout do
begin
dwStatus := MsgWaitForMultipleObjectsEx(0, Pointer(nil)^, dwTimeout - dwElapsed, QS_ALLINPUT, MWMO_WAITANY or MWMO_INPUTAVAILABLE);
if dwStatus = WAIT_OBJECT_0 then
begin
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
if Msg.Message = WM_QUIT then
begin
PostQuitMessage(Msg.wParam);
Exit(False); // прервались из-за WM_QUIT
end;
if not CallMsgFilter(Msg, MSGF_SLEEPMSG) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end;
dwElapsed := GetTickCount - dwStart;
end;
Result := True; // таймаут
end;
Эта функция обрабатывает (pumps) сообщения в течение dwTimeout миллисекунд. Ядро идеи заключается в использовании функции MsgWaitForMultipleObjects/Ex в качестве суррогата для WaitMessageTimeout и обработки сообщений, пока не будет достигнут суммарный таймаут. Однако, тут есть много мелких деталей, на которые нужно обращать внимание. Я привожу ссылки на предыдущие сообщения, если вы захотите освежить их в памяти:
- Использование модульной арифметики для избежания проблем переполнения интервалов
- MsgWaitForMultipleObjects и состояние очереди
- Modality, part 3: The WM_QUIT message
- Rules for Using Pointers
- Rescuing thread messages from modal loops via message filters
Расширение этой функции до "ждать на множестве описателей указанное количество времени, обрабатывая в это время сообщения" я оставляю вам в качестве упражнения (вы можете это сделать, не изменяя много строк кода).
1. В строке while (GetTickCount - dwStart) < dwTimeout) do - не хватает открывающей скобки "(" после while.
ОтветитьУдалить2. Данная функция хорошо работает при входном значении от 20-25мсек! Для меньшего входного значения - обработка самой функции даёт слишком большую погрешность, вот код для проверки:
procedure TForm1.Button1Click(Sender: TObject);
var
aa, bb, dd, ii: Integer;
begin
Form1.Memo1.Lines.Append('Запуск процедуры - ' + DateTimeToStr(now));
bb :=0;
for aa := 0 to 1000 do
begin
//Sleep(1); // быстрый вариант
//application.processmessages; // быстрый вариант
SleepMsg(1); // альтернативный, медленный вариант
bb := aa+bb;
for dd := 0 to 10 do
bb := aa+bb;
Form1.Memo1.Lines.Append('----- '+ IntToStr (bb));
end;
Form1.Memo1.Lines.Append('Финиш процедуры - ' + DateTimeToStr(now));
end;
Это, скорее, лишняя закрывающая скобка :) Исправил.
ОтветитьУдалитьНасчёт времени: и Sleep, и GetTickCount, и MsgWaitForMultipleObjectsEx используют системный таймер для измерения времени. Один "тик" системного таймера может быть от 10 до 55 мс.
Я не знаю, в чём может быть отличие по измерению таймаута в Sleep и MsgWaitForMultipleObjectsEx, но в любом случае я не ожидал бы точного измерения интервалов менее 60 мс от этих функций.