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;

我需要在测量过程之间等待0到5秒。 sleep（）的解决方案只能工作到1秒，因为我在程序中有一个RS232通信和一些定时器。 是否有一个替代sleep（）函数，以便程序准确地在这一点等待一定时间？提前谢谢。

Answer 1

正如David所说，对于一个理想的世界，可能会有更优雅的解决方案，或者如果您愿意通过低级设备I / O和线程来解决问题。但是，在您确定更优雅的解决方案之前，另一种方法是围绕 Application.ProcessMessages 创建自己的超时循环（所谓的＆＃34;忙循环＆＃34;） a＆＃34;超时＆＃34;在指定时间后将控制权返回给调用者的行为，同时处理消息。

这可能与此类似：

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;

这也不太理想，因为 Application.ProcessMessages 本身不会返回，直到处理完所有所有消息。最好在每条消息之后检查经过的超时时间，以便我们尽快恢复正常的消息循环。

Application.ProcessMessages 只是调用 ProcessMessage 函数，但这是 TApplication 类的私有，因此我们无法直接调用它。 / p>

幸运的是，在Delphi 7中， ProcessMessage 函数本身相对简单，可以在自定义消息处理器的超时循环中轻松复制。

请注意，要执行此操作，我们需要将一些私有引用（例如 fOnMessage 事件处理程序）更改为 public 等效项我们获得了一些 TApplication 受保护的方法，我们获得了使用本地子类和类型转换的访问权限（一个原始的前传到＆＃34;类助手＆ ＃34;但适用于所有版本的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;

我使用粗略的乘数和截断现在日期/时间来获得毫秒精度经过时间计数器，而无需处理 GetTickCount <的回绕（潜在）问题/ strong>即可。您可能希望将其修改为使用HPC或仅处理 GetTickCount 环绕。

我们合并了一个 WaitMessage 机制，这样如果没有要处理的消息，那么代码就会（有效地）等待任何新消息。为了确保我们不等待超过超时期限的消息，我们最初为指定的超时设置了一个计时器事件。这可以保证 WM_TIMER 消息将到达以指示超时到期，这将唤醒＆＃34;唤醒＆＃34;我们的消息循环如果在超时到期时仍在等待。

需要注意的另一件事是 WM_QUIT 消息会重新发布到消息队列中。这是为了确保在 ProcessMessagesFor（）循环超时并且主应用程序消息循环再次处理消息时正确处理这些内容。

此功能（严格来说）不会调用 Application.ProcessMessages ，也不会涉及 Sleep（），但它仍然不是一个易受攻击的理想解决方案（具有＆＃34;内联＆＃34;潜在的重新入侵问题消息循环总是创建。这些可以通过控制用户与部分UI的交互来管理，这些部分可能会导致这种重入问题（即在处理完成时禁用表单或控件）。

但即使没有这样的改进，它也可能让你继续处理当前的问题，除非并找到更理想的解决方案。

Answer 2

我无法从你的消息来源告诉你，但如果你将RS232和等待结合起来，睡眠听起来就像个坏主意。您可以做的最好的事情是，只要数据进入，系统就会立即响应您，而不是盲目地等待它。根据您用于进行RS232通信的内容，您应该查找SetCommTimeouts之类的内容并微调读取操作的行为：如果数据尚未处理，则停止接收超时，之后响应为零收到了字节。这最好是从一个专用线程（可能需要一点学习才能获得）。另一种选择是使用异步调用（这也需要一些学习来解决）。

Answer 3

创建自己的睡眠功能：

procedure MySleep (const uSec: UInt);

var uStart : UInt;

begin
  uStart := GetTickCount;

  while (GetTickCount < (uStart + (uSec * 1000))) do
  begin
    Sleep (250);
    Application.ProcessMessages;
  end
end;