Multimedia Timer

[hanspeter]

Hallo,

ich versuche über einen Multimedia Timer einen Zeittakt von 1 ms zu erzeugen.
Das funktioniert auch aber nach ca. 1 min stüzt das Programm mit einen Stack overflow ab.

Aufruf :

TimeSetEvent(1, 0, @TimeCallBack, 0, TIME_PERIODIC); und die Callback Procedure:

Delphi-Quellcode:

procedure TimeCallBack; 
begin
  if run <> nil then
    run.Takt1ms;
end;

bzw.

procedure TimeCallBack;  stdcall;

Der Fehler tritt auch auf, wenn die Procedure TimeCallBack keine Funktion hat.

Delphi-Quellcode:

procedure TimeCallBack; 
begin
  exit;
end;

TimeSetEvent wird im Create eines threads aufgerufen.

Mein Fehler oder Delphifehler ?
Hat wer eine Idee.


Gruß Peter

[hanspeter]

Ic hatte im Beispiel vergessen die Parameter (aus dem Interfaceteil anzugeben)
Hier der Nachtrag.

procedure TimeCallBack(TimerID, Msg: Uint; dwUser, dw1, dw2: DWORD);

Im Schweizer Forum ist ein Beispiel für den Multimedia Timer.
Dieses zeigt den gleichen Fehler. Nach etwa 6000 Zyklen kommt ein Stacküberlauf.
Ich gehe jetzt davon aus, dass das ein Delphi Fehler ist und der Timer unter XE2 nicht mehr funktioniert.

Gruß

[musicman56]

Hallo,

bei mir funzt der Timer unter XE2. Hast du schon mal im 2.Parameter (uResolution) eine 1 versucht? Müsste eigentlich ja ausreichen

EDIT: Hast du "Vcl.StdStyleActnCtrls" in die Uses-Liste aufgenommen?

Ausserdem: procedure TimerProc(uTimerID, uMessage, dwUser, dw1, dw2: DWORD); stdcall;

[hanspeter]

Interesant,
wenn ich den 2.Parameter(uResolution) auf 1 setze, dann läuft es doppelt so lange.
Parameter 0 Absturz nach ca. 1400 Zyklen , Parameter 1 cy. 2400 Zyklen dann Absturz.

Hier ist nochmal das ganze Programm:

Delphi-Quellcode:

unit Unit5;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, MMSystem;

type
  TForm5 = class(TForm)
    lbl1: TLabel;
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

var
  mmResult: Integer;
  anz : integer;
procedure TimeCallBack(TimerID, Msg: Uint; dwUser, dw1, dw2: DWORD); pascal;
begin
  if Form5.lbl1.Caption = 'Tick' then  Form5.lbl1.Caption:= 'Tack'
  else
   Form5.lbl1.Caption := 'Tick';
  inc(anz);
  Form5.lbl2.Caption := inttostr(anz);
end;


procedure TForm5.btn1Click(Sender: TObject);
begin
  anz := 0;
  mmResult := TimeSetEvent(10, 1, @TimeCallBack, 0, TIME_PERIODIC);
end;

end.

Grüße

[Bummi]

Das TimerEvent kommt in einem eigene Thread daher und greift unsynchronisiert auf die VCL zu. Wenn Du die VCL-Zugriffe weglässt läuft es.

[hanspeter]

Zitat von Bummi:

Das TimerEvent kommt in einem eigene Thread daher und greift unsynchronisiert auf die VCL zu. Wenn Du die VCL-Zugriffe weglässt läuft es.

Daran liegt es auch nicht.
Sobald ich in der Callbackroutine etwas mache (z.B. nur ein globales Flag setzen) kommt der Fehler.
Ich habe jetzt mal aus zwei Opensource Projekten die auf dem gleichen Prinzip gelösten Highres Timer ausprobiert.
Hier kommt der gleiche Fehler.
(New Audio Components package und basdll)
Da die Routine unter Delphi 7/Win 7 schon mal funktionierte, liegt es an Windows 8 oder XE2.
(Ein Kollege hat ausprobiert unter C# funktioniert diese Routine.)
Da TimeSetEvent ohnehin obsolet ist, probiere ich jetzt mal die Alternative.

Gruß Peter

[musicman56]

[QUOTE=hanspeter;1200197]

Zitat von Bummi:

Da TimeSetEvent ohnehin obsolet ist, probiere ich jetzt mal die Alternative.

Wieso ist das obsolet? Habe nichts darüber gefunden.

Und nochmals: Unter XE2 funktioniert der Timer bei mit einwandfrei. Nimm die VCL-Komponente, füge manuell "Vcl.StdStyleActnCtrls" zur Uses-Liste, dann tut's

[DeddyH]

Zitat von musicman56:

Wieso ist das obsolet? Habe nichts darüber gefunden.

Wo hast Du denn geschaut? timeSetEvent:

Zitat:

Note This function is obsolete. New applications should use CreateTimerQueueTimer to create a timer-queue timer.

[hanspeter]

Also um das Thema abzuschließen.
timeSetEvent funktioniert unter XE2 und W8 nicht.
Nach ca. 1500 Zyklen tritt ein Stack-Überlauf auf.
timeSetEvent wollte ich nutzen um einen Takt für eine Steuerung 1ms/10ms/100ms zu erzeugen.
Mit 2 Opensource Highres Timern trat das gleiche Problem auf.
Irgendwo hier im Forum wird erwähnt das timeSetEvent veraltert ist und besser CreateTimerQueueTimer verwendet wird.
Ich habe das Problem jetzt mit CreateTimerQueueTimer gelöst.
Jetzt funktioniert es in der gewünschten Form.
Für Interessenten, in der Anlage mal die komplette Lösung.

Gruß
Peter

Delphi-Quellcode:

unit UpProcess;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, System.SyncObjs, engbaslib, MMSystem, Vcl.StdStyleActnCtrls;

  type
    pCallback =  procedure of Object;

type
  TProcessRun = class(TThread)
  private
    aPause : integer;
    FCS    : TCriticalSection;
  protected
    procedure Execute; override;
  public
    run1ms       : boolean;
    TimeTakt     : int64;
    TimeTakt10   : integer;
    TimeTakt100  : integer;
    TimeTakt1000 : integer;
    Pause        : integer;
    Callback1ms   : pCallback;
    Callback10ms  : pCallback;
    Callback100ms : pCallback;
    Callback1000ms: pCallback;
    Constructor Create;overload;
    destructor Destroy; override;
    procedure Stopp;
  end;

Var
  FTimer: THandle;
  run:   TProcessRun;

implementation

procedure WaitOrTimer(Context: Pointer; Success: Boolean) stdcall;
begin
  inc(run.TimeTakt10);
  inc(run.TimeTakt100);
  inc(run.TimeTakt1000);
  run.run1ms := true;
end;

Constructor TProcessRun.Create;
begin
  Self.Create(true);
  FreeOnTerminate:=true;
  Priority:= tpHighest;
  TimeTakt     := 0;
  TimeTakt10   := 0;
  TimeTakt100  := 0;
  TimeTakt1000 := 0;
  Pause        := 0;
  FCS := TCriticalSection.Create;
  if not CreateTimerQueueTimer(FTimer, 0, WaitOrTimer, 0, 0, 1,
    WT_EXECUTEINTIMERTHREAD) then
    FTimer := 0;
end;

destructor TProcessRun.Destroy;
begin
  Stopp;
  freeandnil(FCS);
  inherited;
end;

procedure TProcessRun.Stopp;
begin
  if FTimer <> 0 then
   begin
     DeleteTimerQueueTimer(0, FTimer, 1);
     FTimer := 0;
   end;
end;

{ TProcessRun }

procedure TProcessRun.Execute;
begin
  NameThreadForDebugging('Processrun');
  while not Terminated do
  begin
    inc(aPause);
    if run1ms then
    begin
      run1ms := false;
      Pause  := aPause;
      aPause := 0;
      // FCS.Enter;

      if Assigned(Callback1ms) then
      begin
        Synchronize(Callback1ms);
      end;

      if TimeTakt10 >= 10 then
      begin
        TimeTakt10 := 0;
        if Assigned(Callback10ms) then Synchronize(Callback10ms);
      end;

      if TimeTakt100 >= 100 then
      begin
        TimeTakt100 := 0;
        if Assigned(Callback100ms) then Synchronize(Callback100ms);
      end;

      if TimeTakt1000 >= 1000 then
      begin
        TimeTakt1000 := 0;
        if Assigned(Callback1000ms) then Synchronize(Callback1000ms);
      end;
  //    FCS.Leave;
    end;
  end;
end;

end

[loirad]

Ich habe das Problem, dass bei dieser Zeile:
mmResult := TimeSetEvent(10, 0, @TimeCallBack, 0, TIME_PERIODIC); folgenden Fehler bekomme:

Code:

Variable erforderlich

Woran liegt das?

Liebe Grüße
loirad