高精度计时器

时间:2014-09-25 17:53:21

标签: delphi timer precision delphi-xe5 onkeyup

我正在制作秒表应用程序,专门用于运动堆叠和速度立方体(在尽可能短的时间内解决Rubik的立方体)。

我希望程序启动一个秒表,按下空格键时显示00:00.00格式的经过时间,分钟,秒和分秒到2位小数,然后再次按空格键时停止计时器。

我尝试了许多选项并下载了源代码和各种秒表类来尝试解决我的问题但是当我运行程序与真正的秒表并行时,我的计时器落后了。我似乎无法获得正确的计时器代码,该计时器在按下空格键时启动和停止。

我在Delphi XE5工作。我真的很感激任何帮助。

1 个答案:

答案 0 :(得分:3)

第一次反思

在我继续之前,有些反思:

  • 如果由于之间的延迟而启动计时器时存在延迟 那么用户 - 键盘 - 代码就不应该有一个相对平等的 再次按下空格键以停止计时器时滞后?
  • Windows不是实时操作系统。如果您的申请需要 实时精确,您可能想要选择另一个平台。
  • 无线键盘可能会增加延迟......

检测按键

我可以想到两种不同的机制来检测是否按下了空格键:

  • OnKeyDown - 基于窗口消息传递的标准Delphi事件(慢速??)
  • GetAsyncKeyState() - 无论输入队列状态如何,都读取键盘的物理状态。 (更快??)

<强> Benchmarck

下面是一个使用TStopwatch在两种机制之间进行基准测试的示例。 TStopwatch使用与操作系统相关的功能来访问高分辨率计时器(如果有);否则,使用通常的计时器。我已将GetAsyncKeyState函数放在它自己的线程中。

unit main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.AppEvnts, Winapi.ShellApi, Vcl.StdCtrls, Vcl.ExtCtrls,

  //Add these two units
  System.Diagnostics, System.TimeSpan;

type
  TThreadCheckSpaceKey = class(TThread)
  private
    FStopwatch : TStopwatch;
  public
    property Stopwatch : TStopwatch read FStopWatch;
    constructor Create();
    procedure Execute(); override;
 end;

  TFormMain = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    FThreadCheckSpaceKey : TThreadCheckSpaceKey;
    FStopwatch : TStopwatch;
    procedure DoDrawTimer;
  public

  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

function TimeSpanToStr(aTimeSpan : TTimeSpan):string;
begin
  result := Format('%.*d', [2, aTimeSpan.Minutes])+ ':' +
            Format('%.*d', [2, aTimeSpan.Seconds]) + ':' +
            Copy(Format('%.*d', [3, aTimeSpan.Milliseconds]), 1, 3);
end;

procedure TFormMain.DoDrawTimer();
begin
  //This is just an example
  Caption := 'GetAsyncKeyState: ' + TimeSpanToStr(FThreadCheckSpaceKey.Stopwatch.Elapsed) + ' OnKeyDown: ' + TimeSpanToStr(FStopWatch.Elapsed);;
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  FThreadCheckSpaceKey.Terminate;

  FreeAndNil(FThreadCheckSpaceKey);
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  //If in the Delphi IDE then report memory leaks on shutdown
  ReportMemoryLeaksOnShutdown := DebugHook <> 0;

  FStopwatch := TStopWatch.Create;

  FThreadCheckSpaceKey := TThreadCheckSpaceKey.Create;

  //Clear any previos records of the space key being pressed
  GetAsyncKeyState(VK_SPACE);
end;

procedure TFormMain.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
  DoDrawTimer;
end;

procedure TFormMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_SPACE then begin
    if FStopwatch.IsRunning then
       FStopwatch.Stop
    else
       FStopwatch := TStopwatch.StartNew;

    Key := 0; //Don't propogate to underlyning controls
    DoDrawTimer;
  end;
end;

{ TThreadCheckSpaceKey}

function GetBit(Value: SHORT; Index: Byte): Boolean;
begin
  Result := ((Value shr Index) and 1) = 1;
end;

constructor TThreadCheckSpaceKey.Create;
begin
  inherited;
  FStopwatch := TStopWatch.Create;
end;

procedure TThreadCheckSpaceKey.Execute;
var IsDown : boolean;
begin
  inherited;

  while not Terminated do begin
       //If the lowest bit is set then the space bar has been pressed since last check
       //If the higest bit is set then the space bar is down
       if GetBit(GetAsyncKeyState( VK_SPACE ), 15) then begin

          if not IsDown  then
             if FStopwatch.IsRunning then
                FStopwatch.Stop
             else
                FStopwatch := TStopwatch.StartNew;
          IsDown := true;
       end
       else
         IsDown := false;
  end;
end;

end.