Работа с датами и временем

Code:

procedure Delay(dwMilliseconds: Longint);

var

iStart, iStop: DWORD;

begin

iStart := GetTickCount;

repeat

iStop := GetTickCount;

Application.ProcessMessages;

until (iStop - iStart) >= dwMilliseconds;

end;

Code:

procedure Delay(dwMilliseconds: Longint);

{©Drkb v.3(2007): www.drkb, 

®Vit (Vitaly Nevzorov) - nevzorov}

var

iStart, iStop: DWORD;

begin

iStart := GetTickCount;

repeat

iStop := GetTickCount;

sleep(10);

Application.ProcessMessages;

until (iStop - iStart) >= dwMilliseconds;

end;

Code:

procedure Delay(msecs: Longint);

var

targettime: Longint;

Msg: TMsg;

begin

targettime := GetTickCount + msecs;

while targettime > GetTickCount do

if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then

begin

If Msg.message = WM_QUIT Then

begin

PostQuitMessage(msg.wparam);

Break;

end;

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

end;

{

Note:

The elapsed time is stored as a DWORD value.

Therefore, the time will wrap around to zero if the system is

run continuously for 49.7 days.

}

Code:

{

The Sleep function suspends the execution of the current

thread for a specified interval.

}

Sleep(dwMilliseconds: Word);

Code:

Procedure Delay (IntervalinSeconds:integer);

var i:integer;

{©Drkb v.3(2007): www.drkb, 

®Vit (Vitaly Nevzorov) - nevzorov}

begin

For i:=0to IntervalinSeconds*100do

begin

sleep(10);

Application.ProcessMessages;

end;

end;

Code:

var Canceled:boolean; // должна быть объявлена как глобальная переменная модуля

.....

Function Delay (IntervalinSeconds:integer):boolean; //возвращает true если отработала не прерываясь

{©Drkb v.3(2007): www.drkb, 

(Vitaly Nevzorov) - Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.}var i:integer;

begin

Canceled:=false;

For i:=0to IntervalinSeconds*100do

begin

sleep(10);

Application.ProcessMessages;

if Canceled then break;

end;

Result:=not Canceled;

end;

........

Procedure TForm1.onButton1Click(Sender:TObject);

begin

Canceled:=true;

end;

Code:

{

Including the Sleep in the loop prevents the app from hogging

100% of the CPU for doing practically nothing but running around the loop.

}

procedure PauseFunc(delay: DWORD);

var

lTicks: DWORD;

begin

lTicks := GetTickCount + delay;

repeat

Sleep(100);

Application.ProcessMessages;

until (lTicks <= GetTickCount) or Application.Terminated;

end;

Code:

procedure Delay(Milliseconds: Integer);

{by Hagen Reddmann}

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;

end;