TIMERS
> I have to write a server-application (text-mode) in Delphi 3pro > that waits for some input on the serial port. While waiting for input > i need to make my app sleep to give other applications on the server > the chance to use the cpu (so a simple repeat ... until won't work).
repeat while PeekMessage(Msg,0,0,0,pm_Remove) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; until ThereIsSomethingGoingOnOnTheSerialLine;
function MyWndProc(Wnd: HWnd; Msg,wParam,lParam:Integer): Integer; begin case Msg of wm_SerialLineReceivesData: begin ... end; else Result:=CallWindowProc(OldWndProc,Wnd,Msg,wParam,lParam); end; end;
var OldWndProc: Pointer; begin OldWndProc:= Pointer(SetWindowLong(GetActiveWindow,gwl_WndProc, Integer(@MyWndProc))); ... SetWindowLong(GetActiveWindow,gwl_WndProc, Integer(OldWndProc)); end.
From: Tim_Hyder@msn.com (Tim Hyder)
>Delays are still one of the major leaks in Delphi. >I'm using delphi1 and looking for a 2 ms delay with an accuracy of >about >-0 ms +1 ms error. Does anyone know something. >A loop is not accurate enough. Timer component is 18.2 times/sec.
I Have included a module I have used when making some 16 bit screen savers. It has a global called DelayInit which is global and should made in your form create like this
DelayInit := False; Delay(0); {If delay NOT done then init}
This calibrates itself for the system.
unit Globals; interface Uses WinProcs, WinTypes, Messages,Classes, Graphics, IniFiles; Const OT_USER = 1; Var SsType : Integer; { iObjL : Integer; { Current Object LEFT position } { iObjR : Integer; { Current Object RIGHT position } { iObjT : Integer; { Current Object TOP position } Finish : Boolean; TestMode : Boolean; { True if testing } LoopsMs : LongInt; { Ms loops } ScreenWd : Integer; { Screen width } ScreenHt : Integer; { Screen Height } SpotSize : Integer; { Spotlight Size } SpotSpeed : Integer; { Spotlight Speed } DelayInit : Boolean; { True if delay loop initiated } Procedure Delay(Ms : Integer); { Delay for Ms Millsecs } Procedure CursorOff; { Turn the cursor Off } Procedure CursorOn; { Turn the Cursor On } {$IFDEF NOVELL} {$ENDIF} implementation Uses SysUtils, Toolhelp; Procedure CursorOff; { Turn the Cursor Off } Var Cstate : Integer; { Current cursor State } Begin Cstate := ShowCursor(True); { Get State } While Cstate >= 0 do Cstate := ShowCursor(False); { While ON turn Off } End; Procedure CursorOn; { Turn Cursor On } Var Cstate : Integer; { Current cursor State } Begin Cstate := ShowCursor(True); { Get current State } While Cstate < 0 do Cstate := ShowCursor(True); { While off turn on } End; Procedure Delay(Ms : Integer); { Delay for Ms millisecs } {If Ms is passed as 0, then calibrate } Var L,MaxLoops,StartL,EndL,Down,Up,Res : LongInt; { Local Vars } Ti : TTimerInfo; Begin Up := 0; Down := 100000; if Not DelayInit then begin Ti.dwSize := sizeof(LongInt) * 3; TimerCount(@Ti); StartL := Ti.dwmsSinceStart; { Get Start Time } if Not DelayInit then begin { Include the Test } for L := 0 to 100000 do begin { Loop through the following 100000 times } Dec(Down); { Drop it } Res := Abs(Down - Up); { Diff } if Res = 0 then Inc(Res); { Bump } Inc(Up); { Inc } end; end; TimerCount(@Ti); EndL := Ti.dwmsSinceStart; { Get Start Time } LoopsMs := 100000 Div (EndL - StartL); { Calc MS Rate } DelayInit := True; { We are done } end else begin if Ms = 0 then Exit; MaxLoops := LoopsMs * Ms; { Get Number of Loops } for L := 0 to MaxLoops do Begin { Loop through } Dec(Down); { Drop it } Res := Abs(Down - Up); { Diff } if Res = 0 then Inc(Res); { Bump } Inc(Up); { Inc } end end; End; end.
{ File Name: HRTimer.PAS V1.00 Created: Apr 17 1997, 06:40 on the ThinkPAd by John Mertus Revision #6: Oct 12 1997, 10:56 on the Gateway by John Mertus This is a wrapper around the High Resolution Timer in Win95/WinNT Var HRT : THRTimer HRT := THRTimer.Create; HRT.StartTimer; Resets the timer to zero HRT.ReadTimer; Returns the elapsed time in milliseconds since the time start HRT.Free; Edit history Version 1.00 Initial release } {------------------Unit HRTimer---------------------John Mertus April 97---} Unit HRTimer; {--------------------Interface-------------------------------} interface Uses Windows; Type THRTimer = Class(TObject) Constructor Create; Function StartTimer : Boolean; Function ReadTimer : Double; private StartTime : Double; ClockRate : Double; public Exists : Boolean; End; {------------------------Implementation---------------------------------} implementation {------------------Create-------------------------John Mertus----Mar 97-} Constructor THRTimer.Create; { This reads the windows HR time and stores it for later use. } { } {*************************************************************************} Var QW : TLargeInteger; BEGIN Inherited Create; Exists := QueryPerformanceFrequency(QW); ClockRate := QW.QuadPart; END; {------------------StartTimer---------------------John Mertus----Mar 97-} Function THRTimer.StartTimer : Boolean; { This reads the windows HR time and stores it for later use. } { } {*************************************************************************} Var QW : TLargeInteger; BEGIN Result := QueryPerformanceCounter(QW); StartTime := QW.QuadPart; END; {-------------------ReadTimer---------------------John Mertus----Mar 97---} Function THRTimer.ReadTimer : Double; { This reads the windows HR time and stores it for later use. } { } {*************************************************************************} Var ET : TLargeInteger; BEGIN QueryPerformanceCounter(ET); Result := 1000.0*(ET.QuadPart - StartTime)/ClockRate; END; end.