Delphi 2010 - 实时准确地触发动作

Question

我的第一个问题 - 如果不够具体，请道歉！

我自愿在 Delphi 中为当地的帆船俱乐部编写了一个应用程序。这会每 3 分钟触发各种（RS232 命令）灯 + Klaxon 启动信号，整个序列可能需要 24 分钟。由于水手设置了秒表，因此这必须比 24 分钟内的 1 秒好得多。

我有一个准确的线程计时器组件，并且在Timer.Execute proc 中我需要更新 GUI 等 - 这会导致冻结/崩溃等。有什么更好的方法来做到这一点？

我认为我不应该在执行时更改 GUI 对象，但是如何解决呢？ （我对线程不是很熟悉）。非常感谢您的建议。如果需要任何进一步的信息，我很乐意提供。

克里斯

加法 - CairnTimer 类 code

unit CairnTimer;
interface
uses
  Windows,SysUtils,Classes,Dialogs;
type
  TCairnTimer=class(TComponent)
  private
    TimerOn:             Boolean;
    TimerThreadPriority: TThreadPriority;
    TimerPaused:         Boolean;
    TimerDelay:          Cardinal;
    TimerResolution:     Cardinal;
    TimerTicks:          Cardinal;
    TimerMilliSeconds:   Cardinal;
    OnTimerEvent:        TNotifyEvent;
    OnTimerEventHandle:  Integer;
    TimerName:           Integer;
  protected
    procedure InitTimer;
    procedure SetTimerTicks(NewTicks: Cardinal);
    procedure UpdateTimerStatus(NewOn: Boolean);
    procedure UpdateTimerPriority(NewPriority: TThreadPriority);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Resume;
    procedure Pause;
    property Ticks: Cardinal read TimerTicks default 0;
    property MilliSeconds: Cardinal read TimerMilliSeconds default 0;
  published
    property Enabled: Boolean read TimerOn write UpdateTimerStatus default False;
    property TimerPriority: TThreadPriority read TimerThreadPriority write UpdateTimerPriority default tpNormal;
    property Delay: Cardinal read TimerDelay write TimerDelay default 100;
    property Resolution: Cardinal read TimerResolution write TimerResolution default 10;
    property OnTimer: TNotifyEvent read OnTimerEvent write OnTimerEvent;
  end;

  TCairnTimerThread=class(TThread)
  public
    CairnTimer: TCairnTimer;
    procedure Execute; override;
  end;
  TCairnTimerCallBack=procedure(NA1,NA2,CairnTimerUser,NA3,NA4: Integer) stdcall;
  ECairnTimer=class(Exception);

var
  CairnTimerThread: TCairnTimerThread;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('System',[TCairnTimer]);
end;

function KillTimer(CairnTimerName: Integer): Integer;stdcall;
           external 'WinMM.dll' name 'timeKillEvent';

function SetTimer(TimerDelay,TimerResolution: Integer;
          CairnTimerCallBack: TCairnTimerCallBack;
          CairnTimerUser,CairnTimerFlags: Integer): Integer;stdcall;
          external 'WinMM.dll' name 'timeSetEvent';

procedure TCairnTimerThread.Execute;
var
  TickRecord: Cardinal;
begin
  TickRecord:=0;
  while not(Terminated)and Assigned(CairnTimer)do
  begin
    WaitForSingleObject(CairnTimer.OnTimerEventHandle,INFINITE);
    Inc(TickRecord);
    CairnTimer.SetTimerTicks(TickRecord);
    if Assigned(CairnTimer.OnTimerEvent)then
      CairnTimer.OnTimerEvent(CairnTimer);
  end;
end;

constructor TCairnTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TimerOn:=False;
  TimerDelay:=100;
  TimerResolution:=10;
  TimerPaused:=False;
  TimerTicks:=0;
  TimerMilliSeconds:=0;
  TimerThreadPriority:=tpNormal;
  OnTimerEventHandle:=CreateEvent(nil,False,False,nil);
end;

destructor TCairnTimer.Destroy;
begin
  Enabled:=False;
  CloseHandle(OnTimerEventHandle);
  inherited Destroy;
end;

procedure TCairnTimer.SetTimerTicks(NewTicks: Cardinal);
begin
  TimerTicks:=NewTicks;
  TimerMilliSeconds:=TimerMilliSeconds+TimerDelay;
end;

procedure CairnTimerCallBack(NA1,NA2,CairnTimerUser,NA3,NA4: Integer); stdcall;
var
  CairnTimer: TCairnTimer;
begin
  CairnTimer:=TCairnTimer(CairnTimerUser);
  if Assigned(CairnTimer) then
    if not CairnTimer.TimerPaused then
      SetEvent(CairnTimer.OnTimerEventHandle);
end;

procedure TCairnTimer.InitTimer;
begin
  TimerName:=SetTimer(TimerDelay,TimerResolution,@CairnTimerCallBack,Integer(Self),1);
  if TimerName=0 then
  begin
    TimerOn:=False;
    raise ECairnTimer.Create('Cairn timer creation error.');
  end;
end;

procedure TCairnTimer.UpdateTimerStatus(NewOn: Boolean);
begin
  if NewOn=TimerOn then Exit;
  if (csDesigning in ComponentState) then
  begin
    TimerOn:=NewOn;
    Exit;
  end;
  if(NewOn)then
  begin
    CairnTimerThread:=TCairnTimerThread.Create(True);
    CairnTimerThread.CairnTimer:=Self;
    CairnTimerThread.FreeOnTerminate:=True;
    CairnTimerThread.Priority:=TimerThreadPriority;
    CairnTimerThread.CairnTimer.InitTimer;
    CairnTimerThread.Resume;
    TimerTicks:=0;
    TimerMilliSeconds:=0;
  end;
  if(not(NewOn))then
  begin
    KillTimer(TimerName);
    TerminateThread(CairnTimerThread.Handle,0);
    CairnTimerThread.Free;
  end;
  TimerOn:=NewOn;
end;

procedure TCairnTimer.UpdateTimerPriority(NewPriority: TThreadPriority);
begin
  if NewPriority=TimerThreadPriority then Exit;
  if Assigned(CairnTimerThread) then
  begin
    CairnTimerThread.Priority:=NewPriority;
  end;
  TimerThreadPriority:=NewPriority;
end;

procedure TCairnTimer.Pause;
begin
  if TimerOn then CairnTimerThread.Suspend;
  TimerPaused:=True;
end;

procedure TCairnTimer.Resume;
begin
  if TimerOn then CairnTimerThread.Resume;
  TimerPaused:=False;
end;

end.

Answer 1

要从另一个线程更新 VCL 控件，您必须同步并将线程的方法传递给它。

procedure TMyThread.DoProgress;
 var
   PctDone: Extended;
 begin
   PctDone := (FCounter / FCountTo) ;
   FProgressBar.Position := Round(FProgressBar.Step * PctDone) ;
   FOwnerButton.Caption := FormatFloat('0.00 %', PctDone * 100) ;
 end;

 procedure TMyThread.Execute;
 const
   Interval = 1000000;
 begin
   FreeOnTerminate := True;
   FProgressBar.Max := FCountTo div Interval;
   FProgressBar.Step := FProgressBar.Max;

   while FCounter < FCountTo do
   begin
     if FCounter mod Interval = 0 then Synchronize(DoProgress) ;

     Inc(FCounter) ;
   end;

   FOwnerButton.Caption := 'Start';
   FOwnerButton.OwnedThread := nil;
   FProgressBar.Position := FProgressBar.Max;
 end;

我自己从来不喜欢这个，太紧了。

如果我使用线程执行此操作，我想我会使用共享内存操作，或者如果它很简单，只需几个 Windows 消息。

是线程在为灯和喇叭做通讯？？？

Answer 2

如果您希望长时间保持亚秒级精度，则需要确保您的 PC 时钟准确无误。我见过 PC 时钟可以在一小时内漂移几秒钟，因此完全准确的计时器仍然不够用。为此，我每分钟将我的 PC/笔记本电脑时钟与 NTP 服务器同步（取大约 20 个请求的中值/平均值）。因此，一台好的服务器/PC/笔记本电脑可以始终保持在准确参考时间的几毫秒内。