passpics
asked on
Time critical app stops when any window is moved...
I am writing an application that needs an accurate and continous clock 'pulse' every 40mS or less: basically it's sort of like a MIDI music sequencer, but for another purpose. Everything works fine - I've done a custom component that fires off a NotifyEvent at nice, regular intervals, and I can display that as a time. Here's the beef of my timer component:
procedure TTimecode.RunClock;
var
Interval : single;
fq, ct : int64;
MIDICount : integer;
begin
Interval := FRameRate / 1000;
MIDICount := 0;
while Enabled do //Keep looping
begin
QueryPerformanceFrequency(
Repeat
QueryPerformanceCounter(ct
until (ct - OldCounter) / fq >= Interval; //Time in miliseconds since last loop
OldCounter := ct; //Keep this for next time around
If assigned(OnMIDIFrame) then OnMIDIFrame(self);
inc(MIDICount);
If MIDICount = 5 then MIDICount := 1;
If MIDICount = 1 then
If assigned(OnTCFrame) then OnTCFrame(self);
sleep(1); //Reduces processor load
end;
end;
In my main app code, this is used as follows:
procedure TfrmMain.MasterClockTCFram
var
n : integer;
begin
//Update clocks for any timelines running on internal sync
For n := 0 to length(TL) - 1 do
If TL[n].Sync = syInt then TL[n].Time := TL[n].Time + mspf;
frmTimeline.UpdateClock; //Update the timeline display
end;
TL is a dynamically created array of records, with Time as a field. UpdateClock is a little procedure that simply shows the time in an edit control. mspf is the time to increment in miliseconds for each event (each item in the TL array can have a different time).
Now here's the problem: if I click on any child window's caption bar, the clock stops. I don't mean the form's paint does not update, I mean it's like the whole thread stops, until I release the mouse. TL[x].Time is not updated until I release the mouse. My app is time critical, so this is clearly not good! I tried setting my apps thread priority to REALTIME_PRIORITY_CLASS, but that did not help. Any ideas? I need the clock to always keep counting, even if the user moves a window around.
procedure TTimecode.RunClock;
var
Interval : single;
fq, ct : int64;
MIDICount : integer;
begin
Interval := FRameRate / 1000;
MIDICount := 0;
while Enabled do //Keep looping
begin
QueryPerformanceFrequency(
Repeat
QueryPerformanceCounter(ct
until (ct - OldCounter) / fq >= Interval; //Time in miliseconds since last loop
OldCounter := ct; //Keep this for next time around
If assigned(OnMIDIFrame) then OnMIDIFrame(self);
inc(MIDICount);
If MIDICount = 5 then MIDICount := 1;
If MIDICount = 1 then
If assigned(OnTCFrame) then OnTCFrame(self);
sleep(1); //Reduces processor load
end;
end;
In my main app code, this is used as follows:
procedure TfrmMain.MasterClockTCFram
var
n : integer;
begin
//Update clocks for any timelines running on internal sync
For n := 0 to length(TL) - 1 do
If TL[n].Sync = syInt then TL[n].Time := TL[n].Time + mspf;
frmTimeline.UpdateClock; //Update the timeline display
end;
TL is a dynamically created array of records, with Time as a field. UpdateClock is a little procedure that simply shows the time in an edit control. mspf is the time to increment in miliseconds for each event (each item in the TL array can have a different time).
Now here's the problem: if I click on any child window's caption bar, the clock stops. I don't mean the form's paint does not update, I mean it's like the whole thread stops, until I release the mouse. TL[x].Time is not updated until I release the mouse. My app is time critical, so this is clearly not good! I tried setting my apps thread priority to REALTIME_PRIORITY_CLASS, but that did not help. Any ideas? I need the clock to always keep counting, even if the user moves a window around.
Last Comment
You need to do everything in separated thread... everything stops because moving a form pauses vcl thread...
ASKER
Thanks for the quick response.
And there's no way to prevent that? I'm going to have a lot of interaction between the UI and the timed event processing, so putting all my timing / processing stuff in another thread will be a bit of a pain. I don't care if moving a window becomes jerky or otherwise not pretty - UI is less important than timing.
And there's no way to prevent that? I'm going to have a lot of interaction between the UI and the timed event processing, so putting all my timing / processing stuff in another thread will be a bit of a pain. I don't care if moving a window becomes jerky or otherwise not pretty - UI is less important than timing.
ASKER CERTIFIED SOLUTION
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
ASKER
Ummm, OK. Seems sort of crazy. I wonder why it does this?
I Can't use the MM Timer, because I need more accuracy (like 33.333mS), and QueryPerformanceCounter is more accurate - it measures in nanoseconds. Although of course this is all dependent of how accurate the actual processor clock / Windows is....
So I guess I'm into a whole new game with thread communication then. Expect more questions soon - I'm new to this sort of thing!
Anyway, thanks again. If I hear no other responses in the next few days that change my mind, you get the points.
I Can't use the MM Timer, because I need more accuracy (like 33.333mS), and QueryPerformanceCounter is more accurate - it measures in nanoseconds. Although of course this is all dependent of how accurate the actual processor clock / Windows is....
So I guess I'm into a whole new game with thread communication then. Expect more questions soon - I'm new to this sort of thing!
Anyway, thanks again. If I hear no other responses in the next few days that change my mind, you get the points.
ASKER
OK, I've written the thread code, and that fixed the problem. Thanks again, and I'm awarding the points to you. As I say I'm new to threads, so does the following look OK to you?
type
TMainClock = class(TThread)
private
{ Private declarations }
OldCounter : single;
Interval : single;
procedure SetInterval;
procedure postmainmessage(msg:shorts
protected
procedure Execute; override;
...
procedure TMainClock.Execute;
var
fq, ct : int64;
MIDICount : integer;
begin
{
We basically loop around, checking on the highest performance clock
available in the system, until we are >= Interval (= MIDIInterval in nanoseconds)
}
FreeOnTerminate := true; //Frees thread when terminated.
Synchronize(SetInterval); //In case it's being used by someone else
MIDICount := 0;
while not(Terminated) do //Keep looping until the thread gets terminated
begin
QueryPerformanceFrequency(
Repeat
QueryPerformanceCounter(ct
until (ct - OldCounter) / fq >= Interval; //Time in miliseconds since last loop
OldCounter := ct; //Keep this for next time around
postmainmessage('M'); //Send a MIDI type message to the main thread
inc(MIDICount); //Every 4th loop, we send a Frame message
If MIDICount = 5 then MIDICount := 1;
If MIDICount = 1 then postmainmessage('F'); //Send a Frame type message to main thread
sleep(1); //Reduces processor load
end;
end;
procedure TMainClock.postmainmessage
var msgstrptr:PShortstring;
begin
new(msgstrptr);
msgstrptr^:=msg;
postmessage(frmMain.Handle
end;
procedure TMainClock.SetInterval;
begin
Interval := MIDIInterval / 1000;
end;
type
TMainClock = class(TThread)
private
{ Private declarations }
OldCounter : single;
Interval : single;
procedure SetInterval;
procedure postmainmessage(msg:shorts
protected
procedure Execute; override;
...
procedure TMainClock.Execute;
var
fq, ct : int64;
MIDICount : integer;
begin
{
We basically loop around, checking on the highest performance clock
available in the system, until we are >= Interval (= MIDIInterval in nanoseconds)
}
FreeOnTerminate := true; //Frees thread when terminated.
Synchronize(SetInterval); //In case it's being used by someone else
MIDICount := 0;
while not(Terminated) do //Keep looping until the thread gets terminated
begin
QueryPerformanceFrequency(
Repeat
QueryPerformanceCounter(ct
until (ct - OldCounter) / fq >= Interval; //Time in miliseconds since last loop
OldCounter := ct; //Keep this for next time around
postmainmessage('M'); //Send a MIDI type message to the main thread
inc(MIDICount); //Every 4th loop, we send a Frame message
If MIDICount = 5 then MIDICount := 1;
If MIDICount = 1 then postmainmessage('F'); //Send a Frame type message to main thread
sleep(1); //Reduces processor load
end;
end;
procedure TMainClock.postmainmessage
var msgstrptr:PShortstring;
begin
new(msgstrptr);
msgstrptr^:=msg;
postmessage(frmMain.Handle
end;
procedure TMainClock.SetInterval;
begin
Interval := MIDIInterval / 1000;
end;
Almost... you should use synchronize when reffering to main thread (form1)... For this Message should be the global variable of thread and PostMainMessage shouldn't then take any arguments (it will take M from global variable). Then just replace postmainmessage('M'); to Synchronize(PostMainMessag
That will avoid doing 2 things at once by main thread and unexpected behaviour or even crashes.
That will avoid doing 2 things at once by main thread and unexpected behaviour or even crashes.
Oh well... maybe i'm not really right, the code seems to be ok since postmessage doesn't affect main thread directly, so leave it like this and it should be good.
Delphi
Delphi is the most powerful Object Pascal IDE and component library for cross-platform Native App Development with flexible Cloud services and broad IoT connectivity. It provides powerful VCL controls for Windows 10 and enables FMX development for Windows, Mac and Mobile. Delphi is your choice for ultrafast Enterprise Strong Development™. Look for increased memory for large projects, extended multi-monitor support, improved Object Inspector and much more. Delphi is 5x faster for development and deployment across multiple desktop, mobile, cloud and database platforms including 32-bit and 64-bit Windows 10.
60K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
TRUSTED BY
