Question

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

我自愿在德尔福为当地帆船俱乐部写一个应用程序。每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;

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

如果我使用线程执行此操作，我认为我将使用共享内存manouevre或者只是一些简单的窗口消息。

正在为光和角做通信的线程???

Answer 2

如果您想在很长一段时间内获得亚秒精度，则需要确保您的PC时钟准确无误。我已经看到PC时钟可以在一小时内漂移几秒钟，因此完全准确的计时器仍然不够。为此，我每分钟将我的PC /笔记本电脑时钟与NTP服务器同步（取大约20个请求的中位数/平均值）。因此，良好的服务器/ PC /笔记本电脑可以在精确的参考时间内保持几毫秒。

Delphi 2010 - 实时准确触发操作

2 个答案: