ヒントがタイマーを中断するのを防ぐ方法

Question

I asked this question beforeはやや異なった方法です。その瞬間、私はフォーラムから得た回答を試してみるまで、問題がどういうものだったのか分かりませんでした。問題はこれです：

私は良いタイマーが欲しいです。私は今、4つ持っているが、彼らはすべて簡単なヒントで中断される。私はアプリケーションを起動したり、重い計算を実行したりすることができます。タイマーは機能しません。 1つのヒントが可聴遅延を生成します。私はtried all 4 timersであり、基本的に同じ動作を示します。それらのうちのいくつかは、最も優先順位の高いスレッドで実行されます。

1つのタイマーのコードは次のようになります。私は他のものを追加することができますが、それは私が思うところではありません。 DelphiやWindowsには本質的なものがあり、Timecriticalスレッドより優先度が高いようです。

ユニット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プレーヤーには非常に聞こえますが、ここにリストするには大きすぎます。私はいくつかのApplication.Hint *設定を持っていましたが、これに対するすべての参照を削除しました。これは何の違いもありませんでした。

私が間違っていることを知っている人はいますか？

Answer 1

Application.ProcessMessagesは、バックグラウンドスレッドから呼び出しています。それをしないでください！

1. これを行うと、Windows以外のスレッドでWindowsメッセージが処理されています。 VCLはそれを期待せず、これはさまざまな問題を引き起こす可能性があります。
2. ProcessMessagesを呼び出すと、不明な長さの遅延が発生します。 ProcessMessagesが戻るまでにどれくらいの時間がかかるかはわかりません。
3. バックグラウンドスレッドでメッセージを処理する必要はありません。何もする必要がない場合は、Sleep（0）またはSwitchToThreadを呼び出します。

再3：あなたの提案のための

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