An alternative to sleep () function in Delphi7

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

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 2

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 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;