TTimer viel zu ungenau

Zur Vorstellung von Komponenten und Units für Lazarus

TTimer viel zu ungenau

Beitragvon siro » 23. Jan 2017, 23:14 TTimer viel zu ungenau

Hallo,

ich habe grad mal den TTimer ausprobiert und war entsetzt wie ungenau der ist :shock:
Da ich in schon früher in Delphi 6 das gleiche Problem hatte, habe ich eine MultiMedia Timer Komponente gebaut
und die funktioniert (leider nur in Windows :wink: ) wesentlich genauer. Hier kann man wirklich mit Einer Millisekunde arbeiten.

Den Code stelle ich euch gern zur Verfügung, vielleicht kann man ja davon was gebrauchen...

Code: Alles auswählen
{ Siro, am 23.01.2017  fuer Lazarus Windows angepasst }
unit PrecTimer;
 
interface
 
uses
  Windows, Classes, MMSystem;
 
CONST DefaultTimerResolution = 1;    { minimale Auflösung des Timers 1 ms }
      DefaultTimerIntervall  = 1000; { Standard Intervallzeit 1 Sekunde }
 
{ neue Definition des Ereignisses OnTimer. }
{ Bei OnTimer wird ein Zeitwert "Time" übergeben. Hier wird die Zeit in }
{ Mili Sekunden nach dem Start bzw. letztem Reset des Timers übergeben. }
 
Type TOnTimer = procedure(Sender:TObject) of Object;
 
Type TPreciseTimer = class(TComponent)
  private
    FAutoStart   : Boolean;   { TRUE = Timer automatisch starten }
    FInTimerProc : Boolean;   { Anti Rekursions Flag }
    FTimerRes    : DWORD;     { minimale Auflösung in milli Sekunden }
    FTimerID     : DWORD;     { von Windows vergebene Timer Ident Nummer }
    FInterval    : DWord;     { Aufrufintervall in milli Sekunden }
    FRunning     : Boolean;   { TRUE = Timer lauft }
    FOnTimer     : TOnTimer;  { Benutzer Routine "OnTimer" im Objectinspector }
  protected
    procedure SetInterval(NewInterval:DWORD);
    procedure SetTimerRes(NewRes:DWORD);
    procedure Loaded; override;                 { wird für AutoStart benötigt }
  public
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
    procedure Start;    { Startet den Timer }
    procedure Stop;     { Stoppt den Timer }
    procedure Reset;    { setzt Timerzähler "Time" auf 0 }
  published
    property Interval   : DWORD    read FInterval write SetInterval;
    property Resolution : DWORD    read FTimerRes write SetTimerRes;
    property OnTimer    : TOnTimer read FOnTimer  write FOnTimer;
    property Running    : Boolean  read FRunning;
    property AutoStart  : Boolean  read FAutoStart write FAutoStart;
end;
 
procedure Register;
 
implementation
 
{ ! ALLE Timer rufen diese Funktion auf. Anhand von "Sender" können die Timer }
{ auseinander gehalten werden. }
{ Diese Routine darf auf keinen Fall in das Object mit aufgenommen werden, }
{ sonst stimmen die Stackübergabe Parameter nicht mehr, da Delphi Komponenten }
{ immer einen unsichtbaren Parameter "Self" mit auf den Stack übergibt. }
{ Die sogenannte "Callback Funktion" von Windows weis davon aber nichts. }
{ Hat ewig gedauert bis der Fehler offensichtlich wurde. }
{ Hier wurde Sicherheitshalber ein Rekursionsflag mit eingebaut. }
{ Falls der letzte Aufruf noch nicht beendet wurde, wird der neue ignoriert, }
{ damit das System nicht hängen bleibt. }
 
procedure TimerProc(uID:UINT;msg:UINT; Sender,dw1,dw2:DWORD); stdcall;
begin
  With TPreciseTimer(TObject(Sender)) do begin
    if FInTimerProc then begin
      Stop;
      FInTimerProc:=FALSE;
      exit;     { der letzte Aufruf wurde noch nicht beendet }
    end;
    FInTimerProc:=TRUE;            { der neue Aufruf ist in Arbeit }
    if Assigned(OnTimer) then OnTimer(TObject(Sender)); { Benutzer Routine }
    FInTimerProc:=FALSE;           { der Aufruf wurde beendet }
  end;
end;
 
constructor TPreciseTimer.create(AOwner: TComponent);
var TimeCaps:TTimeCaps;
begin
  inherited create(AOwner);
  FInterval := DefaultTimerIntervall;
  FTimerRes := DefaultTimerResolution;
 
   { prüfen ob Windows diese Auflösung unterstütz. Wenn nicht wird }
   { die minimale Auflösung die Windows ermöglicht eingestellt. }
 
  timeGetDevCaps(@TimeCaps,SizeOf(TTimeCaps));
  if FTimerRes < TimeCaps.wPeriodMin then FTimerRes:=TimeCaps.wPeriodMin;
end;
 
destructor TPreciseTimer.destroy;
var t:DWORD;
begin
  if FInTimerProc then begin
    t:=GetTickCount64+3000;
    repeat
    until (GetTickCount64 > t) or (NOT FInTimerProc);
  end;
  Stop;
  inherited destroy;
end;
 
procedure TPreciseTimer.Start;   { Startet den Timer }
begin
  if FRunning then exit;         { Timer läuft schon }
  timeBeginPeriod(FTimerRes);
  FTimerId:=timeSetEvent(FInterval,FTimerRes,@TimerProc,DWORD(self),TIME_PERIODIC);
  if FTimerId = 0 then begin     { Windows konnte keinen Timer erzeugen }
    timeEndPeriod(FTimerRes);    { sofort timeEndPeriod aufrufen }
    FRunning:=FALSE;             { Timer läuft demnach nicht }
  end else FRunning:=TRUE;       { ansonsten läuft der Timer }
end;
 
procedure TPreciseTimer.Stop;    { Stoppt den Timer }
begin
  if NOT FRunning then exit;     { wenn Timer schon gestoppt ist }
  if FTimerId = 0 then exit;     { es wurde kein Timer erzeugt }
  timeKillEvent(FTimerId);
  timeEndPeriod(FTimerRes);
  FRunning:=FALSE;               { Timer steht nun }
end;
 
procedure TPreciseTimer.Reset;   { setzt den Zählerstand auf 0 }
begin
 
end;
{ setzt einen neuen Zeitintervall. Wenn der Timer schon läuft, }
{ wird er kurz ausgeschaltet, dann der neue Intervall gesetzt und }
{ wieder eingeschaltet }
procedure TPreciseTimer.SetInterval(NewInterval:DWORD);
var F:Boolean;
begin
  if NewInterval = FInterval then exit;   { steht schon auf dem Wert }
  F:=FRunning;                            { merken ob Timer gerade läuft }
  Stop;                                   { auf jeden Fall den Timer stoppen }
  FInterval:=NewInterval;                 { neune Intervall setzen }
  if F then Start;                        { evtl. Timer wieder starten }
end;
 
procedure TPreciseTimer.SetTimerRes(NewRes:DWORD);
var F:Boolean; TimeCaps:TTimeCaps;
begin
  if NewRes = FTimerRes then exit;       { steht schon auf dem Wert }
  F:=FRunning;                           { merken ob Timer gerade läuft }
  Stop;                                  { auf jeden Fall Timer stoppen }
  FTimerRes:=NewRes;                     { Neue Auflösung setzen }
 
   { prüfen ob Windows diese Auflösung unterstützt. Wenn nicht wird }
   { die minimale Auflösung die Windows angibt benutzt. }
 
  timeGetDevCaps(@TimeCaps,SizeOf(TTimeCaps));
  if FTimerRes < TimeCaps.wPeriodMin then FTimerRes:=TimeCaps.wPeriodMin;
 
  if F then Start;     { evtl. Timer wieder Starten }
end;
 
{ nachdem alle Komponenten initialisiert und geladen wurden, wird automatisch  }
{ für jede Kompoonente "Loaded" aufgerufen. Hier wird, wenn AutoStart auf TRUE }
{ steht der Timer gestartet. }
procedure TPreciseTimer.Loaded;
begin
  if AutoStart then Start;
end;
 
procedure Register;
begin
  RegisterComponents('SiroNeu', [TPreciseTimer]);
end;
 
end.
 
 
Zuletzt geändert von siro am 24. Jan 2017, 10:34, insgesamt 1-mal geändert.
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...
siro
 
Beiträge: 290
Registriert: 23. Aug 2016, 13:25
Wohnort: Berlin
OS, Lazarus, FPC: Windows 7 Windows 8.1 Windows 10 | 
CPU-Target: 64Bit
Nach oben

Beitragvon creed steiger » 23. Jan 2017, 23:51 Re: TTimer viel zu ungenau

Falls du sowas mal unter Linux brauchst kannst du hier schauen

http://wiki.freepascal.org/EpikTimer
creed steiger
 
Beiträge: 939
Registriert: 11. Sep 2006, 21:56

Beitragvon Timm Thaler » 24. Jan 2017, 02:18 Re: TTimer viel zu ungenau

Ich sehe gerade nicht, wo Du die Prio des Threads erhöhst. Sonst kannst Du zwar auf einem Multicore-System das Glück haben, dass da gerade ein Kern frei hat, aber üblicherweise kackt Dir da irgendwann das Multitasking rein. Also ja, ist genauer, aber geh nicht davon aus, dass das immer stimmt.
Timm Thaler
 
Beiträge: 575
Registriert: 20. Mär 2016, 22:14
OS, Lazarus, FPC: Win7-64bit Laz1.64 FPC3.0.4, Raspbian Stretch Laz1.62 FPC3.0.2 | 
CPU-Target: Raspberry Pi 3
Nach oben

Beitragvon siro » 24. Jan 2017, 09:42 Re: TTimer viel zu ungenau

Hallo creed,

den EpikTimer habe ich gestern installiert, aber ehrlich gesagt nicht wirklich verstanden.
Da gibt es gar kein Event OnTimer oder ähnliches und wo stelle ich da die Zeit ein ?

@Timm
Im "Normalfall" läuft der Zeitgeber übers MMSystem sehr gut. Leider hat er keine Priorität,
da hast Du völlig recht, da kann man ausgebremmst werden.

Timing ist halt ein echtes Problem in Windows. Würd ja gerne direkt auf die Hardware zugreifen,
so wie ich es bei den Embedded Controllern mache.
Zeitmessungen bis 10 ns kein Problem über Capture Timer...
Gibt es so etwas überhaut in den modernen Chips auf dem Motherboard ?

Wenn man bedenkt, das bei mir 4 CPU's mit 3,5 GHz laufen udn man schafft es nicht einmal eine Millisekunde
in den Griff zu bekommen, ist das schon ein ziemliches Armutszeugnis :cry:
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...
siro
 
Beiträge: 290
Registriert: 23. Aug 2016, 13:25
Wohnort: Berlin
OS, Lazarus, FPC: Windows 7 Windows 8.1 Windows 10 | 
CPU-Target: 64Bit
Nach oben

Beitragvon mschnell » 24. Jan 2017, 10:10 Re: TTimer viel zu ungenau

Ein Betriebssystem wie Windows oder nicht spezialisiertes Linux ist nicht für Zeitmessungen geeignet.

Timer sind so spezifiziert dass sie frühestens zu einem vorgegebenen Zeitpunkt aktiv werden. Die Aktion kann sich auch durchaus um Sekunden verzögern. Von Genauigkeit kann man da überhaupt nicht reden.

Das ist bei Multimedia-Timer oder Epic Timer nicht anders nur die Wahrscheinlichkeitsverteilung ist vielleicht besser.
(Übrigens: EpicTimer benutzt nur in bestimmten Konfigurationen

Das reicht für "Media"-Applikationen auch aus. Wenn das Video ab und zu mal ruckelt ist das kein Problem.

Für genaue Timer ("Der Kran kippt um, wenn die Zeitbedingung nicht eingehalten wird") braucht man Realtim-Linux oder - was oft einfacher ist - zusätzliche dezidierte embedded Hardware mit einem Single-Chip Prozessor, z.b. über USB gekoppelt.

-Michael.
Zuletzt geändert von mschnell am 24. Jan 2017, 10:20, insgesamt 1-mal geändert.
mschnell
 
Beiträge: 3215
Registriert: 11. Sep 2006, 09:24
Wohnort: Krefeld
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ) | 
CPU-Target: X32 / X64 / ARMv5
Nach oben

Beitragvon siro » 24. Jan 2017, 10:20 Re: TTimer viel zu ungenau

Hallo Michael,
hat denn USB eine uneingeschränkte Priorität ?
wenn ja, welcher USB, denn ich hab ja 10 Stück auf meinem Motherboard.
Für USB brauche ich generell Treiber, die laufen doch auch wieder über das Windows System
zudem habe ich mal gelesen, das der Datenverkehr über USB "gepollt" wird, in festgelegten Zeitabschnitten, keine Interrupts.
Bin da aber nicht wirkllch firm drin, hab das bisher nur so verstanden.
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...
siro
 
Beiträge: 290
Registriert: 23. Aug 2016, 13:25
Wohnort: Berlin
OS, Lazarus, FPC: Windows 7 Windows 8.1 Windows 10 | 
CPU-Target: 64Bit
Nach oben

Beitragvon mschnell » 24. Jan 2017, 10:34 Re: TTimer viel zu ungenau

siro hat geschrieben:hat denn USB eine uneingeschränkte Priorität ? .

Vielleicht jabe ich mich falsch ausgedrückt. Mit externer Hardware über USB kann man nur ein exaktes Timing hinbekommen, wenn die Zeitkritischen Aktionen (z.B. Messungen in einem Zeitraster) komplett auf dem Single-Chip laufen und nur Aufträge oder Ergebnisse über USB kommuniziert werden.

siro hat geschrieben:Für USB brauche ich generell Treiber, die laufen doch auch wieder über das Windows System

Wir verwenden immer die "Serienschnittstellen Emulation". Da braucht man keinen eigenen Treiber, kann aber - wenn man will - einen "Treiber" als Textdatei hinterlegen so dass die spezielle eigene "Geräteklasse" mit dem richtigen Namen versehen angezeigt wird.

siro hat geschrieben:zudem habe ich mal gelesen, das der Datenverkehr über USB "gepollt" wird, in festgelegten Zeitabschnitten, keine Interrupts.

Wie gesagt, das Zeit-Management geht natürlich nicht über USB, nur die Kommunikation der Aufträge und Ergebnisse. Mit den Detail der Übertragung hast du nichts zu tun. Im Pascal Programm verwendest du nur einen COM-Port. Haben es bisher nur mit Windows gemacht, sollte mit Linux aber sehr ähnlich ablaufen.

-Michael
mschnell
 
Beiträge: 3215
Registriert: 11. Sep 2006, 09:24
Wohnort: Krefeld
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ) | 
CPU-Target: X32 / X64 / ARMv5
Nach oben

Beitragvon siro » 24. Jan 2017, 10:49 Re: TTimer viel zu ungenau

Achso, jetzt verstehe ich was Du meinst.
Für die serielle Schnittstelle z.B. hab ich ja auch die Treiber von SILABs oder FTDI, weil RS232 gibts ja kaum noch..... :(
Wie das intern abläuft, keine Ahnung, aber Übertragungen mit 256 Kbaud in Delphi hab ich da auch schon hinbekommmen.
Windows liefert mir dann lediglich die Daten, natürlich nicht Zeitsynchron.
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...
siro
 
Beiträge: 290
Registriert: 23. Aug 2016, 13:25
Wohnort: Berlin
OS, Lazarus, FPC: Windows 7 Windows 8.1 Windows 10 | 
CPU-Target: 64Bit
Nach oben

Beitragvon mschnell » 24. Jan 2017, 11:00 Re: TTimer viel zu ungenau

siro hat geschrieben:aber Übertragungen mit 256 Kbaud in Delphi hab ich da auch schon hinbekommmen. .


Bei der "virtuelle COM" - Kommunikation zwischen einem µP und einem PC über USB hat die Baudrate, die du mit den Schnttstellen-Parametern einstellst, nichts mit der Übertragungsgeschwindigkeit zu tun. Die Baudrate ist einfach ein 64 Bit Wert, der an den µP übertragen wird. Wir benutzen die Baudrate oft, um dem µP Zusatz-Informationen unabhängig vom Nutzdaten-Strom mitzuteilen (z.B. Modus-Umschaltungen etc). Die Stream-Daten-Übertrgung geht immer so schnell wie es beiden Seiten möglich ist. Der Handshake wird vom USB-Protokoll "unter der Hand" abgewickelt.

-Michael
mschnell
 
Beiträge: 3215
Registriert: 11. Sep 2006, 09:24
Wohnort: Krefeld
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ) | 
CPU-Target: X32 / X64 / ARMv5
Nach oben

Beitragvon Timm Thaler » 24. Jan 2017, 12:08 Re: TTimer viel zu ungenau

siro hat geschrieben:man schafft es nicht einmal eine Millisekunde
in den Griff zu bekommen, ist das schon ein ziemliches Armutszeugnis :cry:


Weil man es üblicherweise nicht braucht. Wenn doch, nimmt man zusätzliche interne oder externe Hardware. Ich hatte auch schon eine PCI-Samplingkarte mit 1GHz Samplingrate in nem PC.

siro hat geschrieben:Wie das intern abläuft, keine Ahnung, aber Übertragungen mit 256 Kbaud in Delphi hab ich da auch schon hinbekommmen.


Auch hier übernimmt das Timing eine externe Hardware, Dein Uart-Controller oder FTDI-Chip. Und das war auch schon früher so, als die Rechner noch mit 33 MHz liefen.

Früher, zu Windows98-Zeiten, konnte man auch noch Polling an den Portpins einer RS232 machen, darauf basierten Programmer wie der Ponyprog. Ich hab auch schon ein krudes Steuersignal für eine digitale Modellbahn an den Portpins einer RS232 ausgegeben, dazu musste man aber mit GetTickCounts QueryPerformanceCounter / QueryPerformanceFrequency arbeiten und wirklich die Priorität des Prozesses kurzzeitig erhöhen, damit einem nichts dazwischenfunkt. Das geht heute auch nicht mehr.

Fazit: Wenn man Echtzeit braucht, hängt man sich externe Hardware dran.
Timm Thaler
 
Beiträge: 575
Registriert: 20. Mär 2016, 22:14
OS, Lazarus, FPC: Win7-64bit Laz1.64 FPC3.0.4, Raspbian Stretch Laz1.62 FPC3.0.2 | 
CPU-Target: Raspberry Pi 3
Nach oben

Beitragvon siro » 15. Mär 2017, 15:29 Re: TTimer viel zu ungenau

Hallo zusammen,
ich habe meine Timerkomponente unter Windows nochmal etwas abändern müssen, da ich sie nicht unter Windows 7 compiliert bekommen habe.
Zudem habe ich lang überlegt, wie ich die Zeiten mal prüfe.
Da meine serielle Komponente nun auch funktioniert, dachte ich mir, einfach jede Milli Sekunde ein Byte aussenden und mit dem Ossi sich anschauen.
Das sieht "meistens" :wink: garnicht so schlecht aus:

1ms_seriell_2.jpg


Es gibt aber leider auch Ausreißer, die teilweise nur 130 Mikrosenkunden kurz sind und andere die 2 Millisekunden lang sind.
Im Mittelfeld sieht es aber recht brauchbar aus. Bleibt die Frage ob die Ausreisse vom Timer oder von der Seriellen Kompontne kommen,
dazu schau ich mir grad mal die Funktion QueryPerformanceTimer von Windows an.
Es gibt wohl noch so einige Funktionen zu erforschen.
Auch GetSystemTimeAsFileTime soll angeblich Zeiten in Nanosekunden liefern....
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...
siro
 
Beiträge: 290
Registriert: 23. Aug 2016, 13:25
Wohnort: Berlin
OS, Lazarus, FPC: Windows 7 Windows 8.1 Windows 10 | 
CPU-Target: 64Bit
Nach oben

Beitragvon siro » 15. Mär 2017, 15:37 Re: TTimer viel zu ungenau

Hier ist der AKTUELLE Code für die Komponte :
getestet unter Windows 7, Windows 8.1, Windows 10

zum Testen reicht folgender Code:
Doppelklicken auf das Ereignis OnTimer,
dann folgenden Code eingeben:
Den Intervall hab ich auf 1 also 1 Miilisekunde gestellt und der Zähler verhält sich entsprechend.

Code: Alles auswählen
var x:cardinal;
procedure TForm1.PreciseTimer1Timer(Sender: TObject);
begin
  form1.caption:=IntToStr(x);
  inc(x);
end;



Code: Alles auswählen
 
 
unit PrecTimer;
 
interface
 
uses
  Windows, Classes, MMSystem;
 
CONST DefaultTimerResolution = 1;    { minimale Auflösung des Timers 1 ms }
      DefaultTimerInterval   = 1000; { Standard Intervallzeit 1 Sekunde }
      DefaultAutoStart       = TRUE; { Timer soll automatisch gestartet werden }
 
{ neue Definition des Ereignisses OnTimer. }
{ Bei OnTimer wird ein Zeitwert "Time" übergeben. Hier wird die Zeit in }
{ Mili Sekunden nach dem Start bzw. letztem Reset des Timers übergeben. }
 
Type TOnTimer = procedure(Sender:TObject) of Object;
 
Type TPreciseTimer = class(TComponent)
  private
    FAutoStart   : Boolean;   { TRUE = Timer automatisch starten }
    FInTimerProc : Boolean;   { Anti Rekursions Flag }
    FTimerRes    : DWORD;     { minimale Auflösung in milli Sekunden }
    FTimerID     : DWORD;     { von Windows vergebene Timer Ident Nummer }
    FInterval    : DWord;     { Aufrufintervall in milli Sekunden }
    FRunning     : Boolean;   { TRUE = Timer lauft }
    FOnTimer     : TOnTimer;  { Benutzer Routine "OnTimer" im Objectinspector }
  protected
    procedure SetInterval(NewInterval:DWORD);
    procedure SetTimerRes(NewRes:DWORD);
    procedure Loaded; override;                 { wird für AutoStart benötigt }
  public
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
    procedure Start;    { Startet den Timer }
    procedure Stop;     { Stoppt den Timer }
    procedure Reset;    { setzt Timerzähler "Time" auf 0 }
    property Running    : Boolean read FRunning;
  published
    property Interval   : DWORD    read FInterval  write SetInterval default DefaultTimerInterval;
    property Resolution : DWORD    read FTimerRes  write SetTimerRes default DefaultTimerResolution;
    property AutoStart  : Boolean  read FAutoStart write FAutoStart  default DefaultAutoStart;
    property OnTimer    : TOnTimer read FOnTimer   write FOnTimer;
end;
 
procedure Register;
 
implementation
 
{ ! ALLE Timer rufen diese Funktion auf. Anhand von "Sender" können die Timer }
{ auseinander gehalten werden. }
{ Diese Routine darf auf keinen Fall in das Object mit aufgenommen werden, }
{ sonst stimmen die Stackübergabe Parameter nicht mehr, da Delphi Komponenten }
{ immer einen unsichtbaren Parameter "Self" mit auf den Stack übergibt. }
{ Die sogenannte "Callback Funktion" von Windows weis davon aber nichts. }
{ Hat ewig gedauert bis der Fehler offensichtlich wurde. }
{ Hier wurde Sicherheitshalber ein Rekursionsflag mit eingebaut. }
{ Falls der letzte Aufruf noch nicht beendet wurde, wird der neue ignoriert, }
{ damit das System nicht hängen bleibt. }
 
procedure TimerProc(hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
begin
  With TPreciseTimer(TObject(idEvent)) do begin
    if FInTimerProc then begin
      Stop;
      FInTimerProc:=FALSE;
      exit;     { der letzte Aufruf wurde noch nicht beendet }
    end;
    FInTimerProc:=TRUE;            { der neue Aufruf ist in Arbeit }
    if Assigned(OnTimer) then OnTimer(TObject(idEvent)); { Benutzer Routine }
    FInTimerProc:=FALSE;           { der Aufruf wurde beendet }
  end;
end;
 
constructor TPreciseTimer.create(AOwner: TComponent);
var TimeCaps:TTimeCaps;
begin
  inherited create(AOwner);
  FInterval  := DefaultTimerInterval;
  FTimerRes  := DefaultTimerResolution;
  FAutoStart := DefaultAutoStart;
 
   { prüfen ob Windows diese Auflösung unterstützt. Wenn nicht,      }
   { wird die minimale Auflösung die Windows ermöglicht eingestellt. }
 
  timeGetDevCaps(@TimeCaps,SizeOf(TTimeCaps));
  if FTimerRes < TimeCaps.wPeriodMin then FTimerRes:=TimeCaps.wPeriodMin;
end;
 
destructor TPreciseTimer.destroy;
var t:DWORD;
begin
  if FInTimerProc then begin
    t:=GetTickCount64+3000;
    repeat
    until (GetTickCount64 > t) or (NOT FInTimerProc);
  end;
  Stop;
  inherited destroy;
end;
 
procedure TPreciseTimer.Start;   { Startet den Timer }
begin
    { !!! nicht starten während der DesignPhase }
  if (csDesigning in ComponentState)
  or (csLoading in ComponentState) then exit{ 06.03.2017 }
 
  if FRunning then exit;         { Timer läuft schon }
  timeBeginPeriod(FTimerRes);
  FTimerId:=timeSetEvent(FInterval,FTimerRes,LPTIMECALLBACK(@TimerProc),DWORD_PTR(self),TIME_PERIODIC);
  if FTimerId = 0 then begin     { Windows konnte keinen Timer erzeugen }
    timeEndPeriod(FTimerRes);    { sofort timeEndPeriod aufrufen }
    FRunning:=FALSE;             { Timer läuft demnach nicht }
  end else FRunning:=TRUE;       { ansonsten läuft der Timer }
end;
 
procedure TPreciseTimer.Stop;    { Stoppt den Timer }
begin
  if NOT FRunning then exit;     { wenn Timer schon gestoppt ist }
  if FTimerId = 0 then exit;     { es wurde kein Timer erzeugt }
  timeKillEvent(FTimerId);
  timeEndPeriod(FTimerRes);
  FRunning:=FALSE;               { Timer steht nun }
end;
 
procedure TPreciseTimer.Reset;   { setzt den Zählerstand auf 0 }
var f:Boolean;
begin
  f:=FRunning;
  Stop;
  if f then Start;
end;
 
{ setzt einen neuen Zeitintervall. Wenn der Timer schon läuft, }
{ wird er kurz ausgeschaltet, dann der neue Intervall gesetzt und }
{ wieder eingeschaltet }
procedure TPreciseTimer.SetInterval(NewInterval:DWORD);
var F:Boolean;
begin
  if NewInterval = FInterval then exit;     { steht schon auf dem Wert }
  if NewInterval < 1 then NewInterval := 1; { minimal 1 Millisekunde }
  F:=FRunning;                              { merken ob Timer gerade läuft }
  Stop;                                     { auf jeden Fall den Timer stoppen }
  FInterval:=NewInterval;                   { neune Intervall setzen }
  if F then Start;                          { evtl. Timer wieder starten }
end;
 
procedure TPreciseTimer.SetTimerRes(NewRes:DWORD);
var F:Boolean; TimeCaps:TTimeCaps;
begin
  if NewRes = FTimerRes then exit;       { steht schon auf dem Wert }
  F:=FRunning;                           { merken ob Timer gerade läuft }
  Stop;                                  { auf jeden Fall Timer stoppen }
  FTimerRes:=NewRes;                     { Neue Auflösung setzen }
 
   { prüfen ob Windows diese Auflösung unterstützt. Wenn nicht wird }
   { die minimale Auflösung die Windows angibt benutzt. }
 
  timeGetDevCaps(@TimeCaps,SizeOf(TTimeCaps));
  if FTimerRes < TimeCaps.wPeriodMin then FTimerRes:=TimeCaps.wPeriodMin;
 
  if F then Start;     { evtl. Timer wieder Starten }
end;
 
{ nachdem alle Komponenten initialisiert und geladen wurden, wird automatisch  }
{ für jede Kompoonente "Loaded" aufgerufen. Hier wird, wenn AutoStart auf TRUE }
{ steht, der Timer gestartet. }
procedure TPreciseTimer.Loaded;
begin
  inherited;                   { csLoading wird aus ComponentState gelöscht }
  if AutoStart then Start;
end;
 
procedure Register;
begin
  RegisterComponents('LAZ_WinTimer', [TPreciseTimer]);
end;
 
end.
 
 
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...
siro
 
Beiträge: 290
Registriert: 23. Aug 2016, 13:25
Wohnort: Berlin
OS, Lazarus, FPC: Windows 7 Windows 8.1 Windows 10 | 
CPU-Target: 64Bit
Nach oben

Beitragvon mschnell » 15. Mär 2017, 16:02 Re: TTimer viel zu ungenau

siro hat geschrieben:Den Intervall hab ich auf 1 also 1 Miilisekunde gestellt und der Zähler verhält sich entsprechend.[

Dann versuch mal, parallel dazu in einem anderen Programm jede Menge Dateien zu kopieren.

-Michael
mschnell
 
Beiträge: 3215
Registriert: 11. Sep 2006, 09:24
Wohnort: Krefeld
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ) | 
CPU-Target: X32 / X64 / ARMv5
Nach oben

Beitragvon siro » 16. Mär 2017, 14:43 Re: TTimer viel zu ungenau

Ich habe jetzt mal mit dem QueryPerformanceCounter die Zeiten gemessen:

G R A U S A M :

Bei 1 Millisekunde Timer habe ich
0,019 bis 433 Millisekunden gemessen. :cry:

aber insgesamt arbeitet der MMSystem Timer "wesentlich" besser als der TTimer
Super Bremse ist z.B. "CTRL ALT DEL" um den Taskmanager zu öffnen. Da wird der Timer immer um rund 100 Millisekunden ausgebremst.
Man darf halt nix anderes machen, dann läuft es super..... :wink:
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...
siro
 
Beiträge: 290
Registriert: 23. Aug 2016, 13:25
Wohnort: Berlin
OS, Lazarus, FPC: Windows 7 Windows 8.1 Windows 10 | 
CPU-Target: 64Bit
Nach oben

Beitragvon mschnell » 16. Mär 2017, 15:09 Re: TTimer viel zu ungenau

siro hat geschrieben:Man darf halt nix anderes machen, dann läuft es super..... :wink:
Dann sag das mal Deinem Betriebssystem :D :D :D :evil: :evil: :evil:
-Michael
mschnell
 
Beiträge: 3215
Registriert: 11. Sep 2006, 09:24
Wohnort: Krefeld
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ) | 
CPU-Target: X32 / X64 / ARMv5
Nach oben

» Weitere Beiträge siehe nächste Seite »
Nächste

Zurück zu Units/Komponenten



Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste

porpoises-institution
accuracy-worried