Project JEDI - Issue Tracker
Mantis Bugtracker

Viewing Issue Simple Details Jump to Notes ] View Advanced ] Issue History ] Print ]
ID Category Severity Reproducibility Date Submitted Last Update
0004817 [JEDI VCL] 00 JVCL Components tweak always 2009-06-10 16:41 2009-07-03 17:23
Reporter ZENsan View Status public  
Assigned To obones
Priority normal Resolution fixed  
Status resolved   Product Version Daily / GIT
Summary 0004817: TJVTimer incompatibility with TTimer
Description If JvTimer.Threaded then there is followinf situation:

JvTimer.Enabled := True;
...some time smaller than Interval...
JvTimer.Enabled := False; //UpdateTimer procedure MUST reset CurrectDuration
//so that after we set Enabled to True again, timer will execute event only after Interval miliseconds after we set it to Enabled, not after left miliseconds interval... like now.
Additional Information Suggested fix for JvTimer.pas:

  TJvTimerThread = class(TThread)
    FOwner: TJvTimer;
    FInterval: Cardinal;
    FException: Exception;
    FPaused: Boolean;
    FPauseSection: TCriticalSection;
    FCurrentDuration: Cardinal; //<-this required for updateTimer
    procedure HandleException;
    procedure SetPaused(const Value: Boolean);
    function GetPaused: Boolean;
    procedure Execute; override;
    constructor Create(Timer: TJvTimer; Enabled: Boolean);
    destructor Destroy; override;
    {$IFDEF CLR}
    procedure Synchronize(Method: TThreadMethod); // makes method public
    {$ENDIF CLR}
    property Terminated;

    property Paused: Boolean read GetPaused write SetPaused;
procedure TJvTimerThread.Execute;
  Step = 10; // Time of a wait slot, in milliseconds
  EventTime: TJvTimerEventTime;

  function ThreadClosed: Boolean;
    Result := Terminated or Application.Terminated or (FOwner = nil);

    EventTime := FOwner.EventTime;

    if EventTime = tetPost then
      { Wait first and then trigger the event }
      FCurrentDuration := 0;
      while not ThreadClosed and (FCurrentDuration < FInterval) do
        SleepEx(Step, False);
        Inc(FCurrentDuration, Step);

    if not ThreadClosed and not ThreadClosed and FOwner.FEnabled then
      if FOwner.SyncEvent then
          on E: Exception do
            FException := E;

    if EventTime = tetPre then
      { Wait after the event was triggered }
      FCurrentDuration := 0;
      while not ThreadClosed and (FCurrentDuration < FInterval) do
        SleepEx(Step, False);
        Inc(FCurrentDuration, Step);

    // while we are paused, we do not do anything. However, we do call SleepEx
    // in the alertable state to avoid 100% CPU usage. Note that the delay
    // should not be 0 as it may lead to 100% CPU in that case. 10 is a safe
    // value that is small enough not to have a big impact on restart.
    while Paused and not Terminated do
      SleepEx(10, True);
  until Terminated;
procedure TJvTimer.UpdateTimer;
  if FThreaded then
    (FTimerThread as TJvTimerThread).Paused := True;
    (FTimerThread as TJvTimerThread).FCurrentDuration := 0;
{ if not FTimerThread.Suspended then
    TJvTimerThread(FTimerThread).FInterval := FInterval;
    if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
      FTimerThread.Priority := FThreadPriority;

      (FTimerThread as TJvTimerThread).Paused := False;
(* while FTimerThread.Suspended do
    if not FTimerThread.Suspended then
    if not Assigned(FTimer) then
      FTimer := TTimer.Create(Self);
    FTimer.Interval := FInterval;
    FTimer.OnTimer := FOnTimer;
    FTimer.Enabled := (FInterval <> 0) and FEnabled and Assigned(FOnTimer);
Tags No tags attached.
Attached Files

- Relationships

-  Notes
obones (administrator)
2009-07-03 17:23

This is now in SVN

- Issue History
Date Modified Username Field Change
2009-06-10 16:41 ZENsan New Issue
2009-07-03 17:23 obones Note Added: 0015760
2009-07-03 17:23 obones Status new => resolved
2009-07-03 17:23 obones Fixed in Version => Daily / SVN
2009-07-03 17:23 obones Resolution open => fixed
2009-07-03 17:23 obones Assigned To => obones

Mantis 1.1.6[^]
Copyright © 2000 - 2008 Mantis Group
Powered by Mantis Bugtracker