如何防止提示中断定时器 [英] How to prevent hints interrupting a timer
问题描述
我以稍微不同的方式之前提到此问题。在那一刻，我不知道究竟是什么问题，直到我开始尝试从论坛得到的答案（感谢所有）。问题是这样的：
I asked this question before in a slightly different way. At that moment I had no idea what exactly the problem was until I started to experiment with the answers I got from the forum (thanks all). The problem is this:
对于MIDI生成，我想要一个好的计时器。我现在有四个，但他们都被一个简单的提示打断了。我可以启动应用程序，执行大量的计算，无论如何。定时器功能无汗。一个提示会产生一个可听见的延迟。我尝试所有4个计时器，他们基本上表现出相同的行为。其中一些在最高优先级的线程中运行。
For MIDI generating I want a good timer. I now have four but they all get interrupted by a simple hint. I can start applications, perform heavy computations, whatever. The timer functions with no sweat. One hint generates an audible delay. I tried all 4 timers and they basically show the same behavior. Some of them run in a thread with highest priority.
一个计时器的代码看起来像这样。我可以添加别人，但这不是我的想法。看起来Delphi或Windows中的内在东西比Timecritical线程要优先。
The code of one timer looks like this. I can add others, but that is not the point I think. It appears that there is something intrinsic in either Delphi or Windows that takes higher priority than a Timecritical thread.
unit Timer_Looping;
unit 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 *设置，但是我已经删除了对此的所有引用。这没有什么区别。
I cannot duplicate this behavior in a new program. It exists very audibly in my MIDI player which is too big to list here. I did have some Application.Hint* settings but I have delete all references to this. This made no difference.
任何人都知道我做错了什么？
Anybody any idea what I do wrong?
推荐答案
从后台线程调用Application.ProcessMessages。不要这样做！
You are calling Application.ProcessMessages from a background thread. Don't do that!
- 执行此操作时，会导致在非主线程中处理Windows消息。 VCL不会指望，这可能会导致各种问题。
- 通过调用ProcessMessages，您将引入一个未知长度的延迟。您不知道ProcessMessages需要多长时间才能返回。
- 不需要在后台线程中处理消息。如果你无所事事，可以拨打Sleep（0）或SwitchToThread。
Re 3：你可以使用这样的东西： p>
Re 3: You can use something like this:
procedure Yield;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
asm pause; end
else
Sleep(0);
end;
这篇关于如何防止提示中断定时器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
