An alternative to sleep () function in Delphi7 - oop

Question

IUfMessung = interface
['{6C258E04-BCC9-4349-912B-57A38F103570}']
function MacheMessung(Ifl,Ufl: double): double;
end;
TUFMessungMitHalten = class(TInterfacedObject,IUfMessung)
private
SWZeitHalten: double;
public
constructor Create(ASWZeitHalten: double); // Time to keep
destructor Destroy; override;
function MacheMessung(Ifl,Ufl: double): double; // do measuring
end; // measuring with holding
TUFMessungMitPause = class(TInterfacedObject,IUfMessung)
private
SWZeitPause: double;
IfMin: double;
public
constructor Create(ASWZeitPause: double; AIfMin: double); // Time to keep + I[A]
destructor Destroy; override;
function MacheMessung(Ifl,Ufl: double): double;
end; // measuring with Pause
TUFMessung = class(TInterfacedObject)
private
//...
Messungsart: IUfMessung;
public
procedure SetMessungsart(art: IUfMessung); // set measuring type
procedure MessungsArtAswahl; // measuring type choice
//...
end; // do measuring
{ TUFMessung }
procedure TUFMessung.MessungsArtAswahl;
begin
if not FMitHalten and not FMitPause then // Uf simple measuring
begin
SetMessungsart(TUFMessungEinfach.Create);
end;
if FMitHalten and not FMitPause then // Uf with holding
begin
SetMessungsart(TUFMessungMitHalten.Create(FSWZeitHalten));
end;
if not FMitHalten and FMitPause then // Uf with pause
begin
SetMessungsart(TUFMessungMitPause.Create(FSWZeitPause, FStartIf));
end;
end;
procedure TUFMessung.Start(StartIf, EndIf, StepIf, Uleer: double);
begin
//...
while not FIstFertig and FUfKannStart do
begin
Uf:= Messungsart.MacheMessung(Ifl, FUleer); // <= CALL the measuring
//...
end;
end;
{ TUFMessungMitHalten }
function TUFMessungMitHalten.MacheMessung(Ifl, Ufl: double): double;
var i_Zeit: integer;
begin // Messvorgang
hole_Uf(true, Ifl, Ufl); // set value
i_Zeit:= Trunc(SWZeitHalten*1000);
Application.ProcessMessages;
Sleep(i_Zeit); // wait Time ms.
result:= hole_Uf(false, Ifl, Ufl); // measuring
end;
{ TUFMessungMitPause }
function TUFMessungMitPause.MacheMessung(Ifl, Ufl: double): double;
var i_Zeit: integer;
begin // Messvorgang
result:= hole_Uf(false, Ifl, Ufl); // measuring
hole_Uf(true, IfMin, Ufl); // set value
i_Zeit:= Trunc(SWZeitPause*1000);
Application.ProcessMessages;
Sleep(i_Zeit); // wait Time ms.
end;
I need to wait between the measuring processes for a time from 0 to 5 seconds. The solution with sleep () works well only till 1 second because I have in the program an RS232 communication and some timers.
Is there an alternative to sleep () function so that the program precisely at this point a certain time is waiting for? Thank you in advance.

Answer 1

I can't tell from your source, but if you're combining RS232 and waiting, Sleep sounds like a bad idea. The best you could do is have the system respond to you as soon as data comes in, not blindly wait for it. Depending on what you use to do RS232 communication, you should look for something like SetCommTimeouts and fine-tune how read operations behave: if the data is not in yet, stall for the receive timeout, and after that respond that zero bytes were received. This is best done from a dedicated thread (which might take a little learning to get a hang of). Another option is using asynchronous calls (which also take a little learning to get a hang of).

Answer 2

As David says, there may be more elegant solutions for an ideal world, or if you are willing to get your hands dirty with low level device I/O and threading. But until you have perhaps identified a more elegant solution, another approach would be to create your own time-out loop (a so called "busy loop") around Application.ProcessMessages to incorporate a "time-out" behaviour to return control to the caller after a specified time, processing messages in the meantime.
This might look something similar to this:
procedure ProcessMessagesFor(aTimeOut: Integer);
var
start: Int64;
elapsed: Integer;
begin
start := Trunc(Now * 24 * 60 * 60 * 1000);
elapsed := 0;
while elapsed < aTimeout do
begin
Application.ProcessMessages;
elapsed := Trunc(Now * 24 * 60 * 60 * 1000) - start;
end;
end;
This is also less than ideal however since Application.ProcessMessages will itself not return until any and all messages have been processed. It would be better to check for the elapsed timeout after each message so that we can get back into the normal message loop as soon as possible.
Application.ProcessMessages simply calls a ProcessMessage function, but this is private to the TApplication class, so we cannot call this directly.
Fortunately, in Delphi 7, the ProcessMessage function is itself relatively simple and can be easily replicated within the timeout loop of a custom message processor.
Note that to do this we need to change a couple of private references (fOnMessage event handler for example) to the public equivalents and a handful of TApplication protected methods are involved which we obtain access to using a local sub-class and type-casting (a primitive pre-cursor to "class helpers" but which works in all versions of Delphi):
type
// Creates a sub-class in scope which we can use in a typecast
// to gain access to protected members of the target superclass
TApplicationHelper = class(TApplication);
procedure ProcessMessagesFor(aTimeOut: Integer);
var
start: Int64;
elapsed: Integer;
wait: Boolean;
function ProcessMessage: Boolean;
var
msg: TMsg;
handled: Boolean;
app: TApplicationHelper;
begin
app := TApplicationHelper(Application);
result := False;
if PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
begin
result := True;
if msg.Message <> WM_QUIT then
begin
handled := False;
if Assigned(Application.OnMessage) then
Application.OnMessage(msg, handled);
if not app.IsHintMsg(msg)
and not handled
and not app.IsMDIMsg(msg)
and not app.IsKeyMsg(msg)
and not app.IsDlgMsg(msg) then
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end
else
PostQuitMessage(msg.wParam);
end;
end;
begin
wait := FALSE; // We will not wait for messages initially
start := Trunc(Now * 24 * 60 * 60 * 1000);
SetTimer(0, 0, aTimeout, NIL); // Makes sure we get a message (WM_TIMER) at the end of the timeout period
repeat
if wait then
WaitMessage;
wait := NOT ProcessMessage; // If there was no message then we will wait for one next time around
elapsed := Trunc(Now * 24 * 60 * 60 * 1000) - start;
until (elapsed >= aTimeout);
end;
I have used a crude multiplier and truncation of a Now date/time to obtain a millisecond precision elapsed time counter without having to deal with the wrap around (potential) issue with GetTickCount. You may want to modify this to use a HPC or simply deal with the GetTickCount wrap-around.
We incorporate a WaitMessage mechanism so that if there are no messages to be processed then the code simply waits (efficiently) for any new messages. To ensure that we are not waiting for messages beyond the timeout period, we initially set a timer event for the specified timeout. This guarantees that a WM_TIMER message will arrive to signal the expiry of the timeout, which will "wake up" our message loop if it is still waiting when the timeout has expired.
Another thing to note is that WM_QUIT messages are re-posted to the message queue. This is to ensure that these will be handled correctly when the ProcessMessagesFor() loop has timed out and messages are once again being handled by the main application message loop.
This function does not (strictly speaking) call Application.ProcessMessages, nor does it involve Sleep(), but it is still not an ideal solution being vulnerable to (potential) re-entrancy problems that having "inline" message loops always creates. These can be managed by controlling user interaction with parts of the UI that might cause such re-entrancy problems (i.e. disable forms or controls while processing is completed).
But even without such refinements it may keep you going with your current problem unless and until a more ideal solution is found.

Answer 3

Create you own sleep function:
procedure MySleep (const uSec: UInt);
var uStart : UInt;
begin
uStart := GetTickCount;
while (GetTickCount < (uStart + (uSec * 1000))) do
begin
Sleep (250);
Application.ProcessMessages;
end
end;