[ALexandr555]

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

procedure TForm1.Delay (Milliseconds: Integer); var Tick: DWord; Event: THandle; begin Event := CreateEvent(nil, False, False, nil); try Tick := GetTickCount + DWord(Milliseconds); while (Milliseconds > 0) and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do begin Application.ProcessMessages; Milliseconds := Tick - GetTickcount; end; finally CloseHandle(Event); end;

в принципе все хорошо полностью не тормозит программу, но вот закрыть во время паузы нельзя, можно ли решить эту проблему

[v1s2222]

В программе создавай глобальную переменную, например NowQuit: Boolean = False;

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

procedure TForm1.Delay (Milliseconds: Integer); var Tick: DWord; Event: THandle; begin Event := CreateEvent(nil, False, False, nil); try Tick := GetTickCount + DWord(Milliseconds); <font color="Red">while not NowQuit do begin</font> while (Milliseconds > 0) and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do begin Application.ProcessMessages; Milliseconds := Tick - GetTickcount; end; <font color="Red">end;</font> finally CloseHandle(Event); end;

Как-то так. Думаю понял про что я. И когда надо выйти из программы пиши NowQuit:= True;

[ALexandr555]

ну мне при обычном выходе на крестик

[v1s2222]

Код:

1 2 3 4

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin   NowQuit := True; end;

[ALexandr555]

с этими поправками чтото она совсем безнадежно подвисает

[v1s2222]

Значит чучуть попробуй изменить программу, или используй другую функцию...

Код:

1 2 3 4 5 6 7 8 9 10

procedure Delay(const AMilliseconds: Cardinal); var SaveTickCount: Cardinal; begin SaveTickCount := GetTickCount; repeat Application.ProcessMessages; until GetTickCount - SaveTickCount > AMilliseconds; end;

[Thrasher]

Если я правильно понял суть вопроса, то нужно добавить всего чуть-чуть

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

procedure TForm1.Delay (Milliseconds: Integer); var Tick: DWord; Event: THandle; begin Event := CreateEvent(nil, False, False, nil); try Tick := GetTickCount + DWord(Milliseconds); while (Milliseconds > 0) and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do begin Application.ProcessMessages; Milliseconds := Tick - GetTickcount; <font color="Red">if Application.Terminated then Exit;</font> end; finally CloseHandle(Event); end;