如何防止提示中断计时器

Question

我以前以一种稍微不同的方式问过这个问题。在那一刻，我不知道问题到底是什么，直到我开始用我从论坛上得到的答案进行实验(感谢所有人)。问题是:

对于MIDI生成，我需要一个好的计时器。我现在有四个，但它们都被一个简单的提示打断了。我可以启动应用程序，执行繁重的计算，等等。计时器的功能毫不费力。一个提示会产生听觉延迟。我尝试了所有4个计时器，它们基本上表现出相同的行为。

一个定时器的代码是这样的。我可以补充其他的，但我认为这不是重点。在Delphi或Windows中，似乎有某种内在的东西比时间临界线程具有更高的优先级。

单元Timer_Looping;

  interface
  uses Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls, Forms,
       Dialogs, Timer_Custom;
  type
     TTask = class (TThread)
     private
        FEnabled: boolean;
        FInterval: cardinal;
        FOnTimer: TNotifyEvent;
        procedure Yield;
     public
        constructor Create;
        destructor Destroy; override;
        procedure Execute; override;
        property Enabled: boolean read FEnabled write FEnabled;
        property Interval: cardinal read FInterval write FInterval;
        property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
     end; // Class: TWork //
     TLoopingTimer = class (TBaseTimer)
     protected
        FTask: TTask;
        procedure SetEnabled (value: boolean); override;
        procedure SetInterval (value: cardinal); override;
        procedure SetOnTimer (Task: TNotifyEvent); override;
        procedure StartTimer;
        procedure StopTimer;
     public
        constructor Create;
        destructor Destroy; override;
     end; // Class: TLooping_Timer //
  implementation
  {*******************************************************************
  *                                                                  *
  * Class TTask                                                      *
  *                                                                  *
  ********************************************************************}
  constructor TTask.Create;
  begin
     inherited Create (False);
     Self.Priority := tpTimeCritical;
  end; // Create //
  {$WARN SYMBOL_DEPRECATED OFF}
  destructor TTask.Destroy;
  begin
     Terminate;                 // terminate execute loop
     if Suspended then Resume;  // Resume the Task when waiting
     WaitFor;                   // Wait until the thread is terminated
  end; // Destroy //
  // Return control to another thread, ProcessMessages without the disadvantages
  procedure TTask.Yield;
  begin
     if Win32MajorVersion >= 6  // Vista, 2008, 7?
        then asm pause; end     // Most efficient
        else SwitchToThread;    // Else: don't use ProcessMessages or Sleep(0)
  end; // yield //
  // Execute loop, calls the callback and suspends. The timer callback
  // resumes the timer
  procedure TTask.Execute;
  var freq, time, limit: Int64;
      ms_interval: Int64;       // Interval in cycles
  begin
     QueryPerformanceFrequency (freq);
     try
        Suspend;
  // Just loop until Terminate is set
        while not Terminated do
        begin
           ms_interval := Interval * freq div 1000;
  // Loop between Enabled and Disabled
           while not Terminated and Enabled do
           begin
              QueryPerformanceCounter (time);
              limit := time + ms_interval;
              if Assigned (OnTimer) then OnTimer (Self);
  // Wait by cycling idly thru cycles. QueryPerformanceCounter is used for precision.
  // When using GetTickCount deviations of over 10ms may occur.
              while time < limit do
              begin
                 yield;
                 QueryPerformanceCounter (time);
              end; // while
           end; // while
           if not Terminated then Suspend;
        end; // while
     except
        Terminate;
     end; // try
  end; // Execute //
  {$WARN SYMBOL_DEPRECATED ON}
  {*******************************************************************
  *                                                                  *
  * Class TLooping_Timer                                             *
  *                                                                  *
  ********************************************************************}
  constructor TLoopingTimer.Create;
  begin
     inherited Create;
     FTask := TTask.Create;
     FTimerName := 'Looping';
  end; // Create //
  // Stop the timer and exit the Execute loop
  Destructor TLoopingTimer.Destroy;
  begin
     Enabled := False;          // stop timer when running
     FTask.Free;
     inherited Destroy;
  end; // Destroy //
  {$WARN SYMBOL_DEPRECATED OFF}
  procedure TLoopingTimer.StartTimer;
  begin
     FTask.Enabled := True;
     FTask.Resume;
  end; // StartBeat //
  {$WARN SYMBOL_DEPRECATED ON}
  procedure TLoopingTimer.StopTimer;
  begin
     FTask.FEnabled := False;
  end; // PauseBeat //
  procedure TLoopingTimer.SetOnTimer (Task: TNotifyEvent);
  begin
     inherited SetOnTimer (Task);
     FTask.OnTimer := Task;
  end; // SetOnTimer //
  // When true, startbeat is called, else stopbeat
  procedure TLoopingTimer.SetEnabled (value: boolean);
  begin
     FEnabled := value;
     if FEnabled
        then StartTimer
        else StopTimer;
  end; // set_enabled //
  procedure TLoopingTimer.SetInterval (value: cardinal);
  begin
     FInterval := value;
     FTask.Interval := Interval;
  end; // SetInterval //
  end. // Unit: MSC_Threaded_Timer //      
  =====================Base class=========================
  unit Timer_Custom;
  interface
  uses
    Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls, Forms,
    Dialogs;
  type
    TCallBack = procedure (uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD);
    ETimer = class (Exception);
  {$M+}
     TBaseTimer = class (TObject)
     protected
        FTimerName: string;     // Name of the timer
        FEnabled: boolean;      // True= timer is running, False = not
        FInterval: Cardinal;      // Interval of timer in ms
        FResolution: Cardinal;    // Resolution of timer in ms
        FOnTimer: TNotifyEvent; // What to do when the hour (ms) strikes
        procedure SetEnabled (value: boolean); virtual;
        procedure SetInterval (value: Cardinal); virtual;
        procedure SetResolution (value: Cardinal); virtual;
        procedure SetOnTimer (Task: TNotifyEvent); virtual;
     public
        constructor Create; overload;
     published
        property TimerName: string read FTimerName;
        property Enabled: boolean read FEnabled write SetEnabled;
        property Interval: Cardinal read FInterval write SetInterval;
        property Resolution: Cardinal read FResolution write SetResolution;
        property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
     end; // Class: HiResTimer //
  implementation
  constructor TBaseTimer.Create;
  begin
     inherited Create;
     FEnabled    := False;
     FInterval   := 500;
     Fresolution := 10;
  end; // Create //
  procedure TBaseTimer.SetEnabled (value: boolean);
  begin
     FEnabled := value;
  end; // SetEnabled //
  procedure TBaseTimer.SetInterval (value: Cardinal);
  begin
     FInterval := value;
  end; // SetInterval //
  procedure TBaseTimer.SetResolution (value: Cardinal);
  begin
     FResolution := value;
  end; // SetResolution //
  procedure TBaseTimer.SetOnTimer (Task: TNotifyEvent);
  begin
     FOnTimer := Task;
  end; // SetOnTimer //
  end. // Unit: MSC_Timer_Custom //

我不能在新程序中复制此行为。它存在于我的MIDI播放器中，因为太大而无法在这里列出。我确实有一些申请。提示*设置，但我已经删除了所有引用这一点。这没什么区别。

有人知道我做错了什么吗?

Answer 1

您正在调用应用程序。来自后台线程的ProcessMessages。别这样!

1. 当你这样做时，你会导致Windows消息在非主线程中处理。VCL不希望这样，这可能会导致各种问题。
通过调用ProcessMessages，你引入了一个未知长度的延迟。你不知道ProcessMessages返回需要多长时间。不需要在后台线程中处理消息。如果你无事可做，调用Sleep(0)或SwitchToThread。

回复3:你可以这样写:

procedure Yield;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    asm pause; end
  else
    Sleep(0);
end;