Pause in Timer setzen

[TeTSuO]

Hallo erstma!

Gibt es eine Timer-Komponente die so ne art Pause eigenschaft hat.

Wenn jetzt zum Beispiel mein Timer ein Interval von 20 Sekunden hat und ich drücke nach 15 sekunden pause soll der Timer angehalten werden. Wenn ich dann wieder auf Play drücke soll dieser fortgesetzt werden, aber nur noch 5 sekunden bis zum nächsten interval.

Wenn jemand eine Komponente kennt oder einen Vorschlag hat wie ich das realiesieren könnte wäre ich echt dankbar!

[sniper_w]

ich weiss nicht ob das mit Enable geht, musst du halt probieren.

EDIT..
Geht nicht.
Du könntest eine Timer mit Interval = 1000 einsetzen und in OnTimer eine Var erhöhen.

So in etwa

Delphi-Quellcode:

var
  n:integer =0 ;
  erlaubt : boolean = true;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if erlaubt then
 begin
  Inc(n);
  if n > 15 then n:=0;
 end;
end;

// pause button
procedure TForm1.Button1Click(Sender: TObject);
begin
 erlaubt := not erlaubt;
end;
// oder etwas umstendlicher....
// pause button 2
procedure TForm1.Button1Click(Sender: TObject);
begin
 if not Assigned(timer1.OnTimer) then
       Timer1.OnTimer := Timer1Timer 
       else
       Timer1.OnTimer := nil;
end;

Und dann musst du nur noch n abfragen.

[Pr0g]

Bau dir doch nen eigenen Timer. Ne Schleife, GetTickCount und Application.ProcessMessages sollten die Sachen sein, die du brauchst.

MfG Pr0g

[SirThornberry]

wenn du "enabled" beim Timer auf "false" setzt hält er an. Das heißt du musst in deinem OnTimer-Event und beim manuellen starten des Timer einfach dir die Zeit merken. Dementsprechend kannst du dann beim nächsten start ausrechnen wieviel Sekunden der Timer noch zu laufen hat.

[TeTSuO]

Danke für eure Vorschläge.

Werde wie Pr0g meint eine selber schreiben.
Wollte eigentlich keine Kompo schreiben wenn's aber keine gibt werde ich das wohl machen (müssen).
Aktualisiere diesen Thread wenn ich die Kompo fertig habe. Stelle diese dann zur Verfügung wenn jemand interesse hat.

[TeTSuO]

Nachdem ich einiges anderes zu programieren hatte habe ich es auch nun geschafft einen Timer zu programmieren der mit PauseTimer.Pause angehalten und mit PauseTimer.Resume fortgesetzt werden kann ohne das der timer nochmal die gesamte Intervalzeit benötigt

Wer's braucht kann sich's runterladen

[Baerlemann]

Hier eine nachbearbeitete Version zur Vermeidung "eingefrorener" Zustand,
mit dem ich in meiner Applikation zu kämpfen hatte.

Delphi-Quellcode:

// 2015-08-26 - Rev.2.0.6.1
// * !HOT BUGFIX! procedure TPauseTimer.Resume:
//   - Ursache für sporadisch "eingefrorener" Timer gefunden
//   - Finterval hat dann Wert $FFFFFFF<x> (In Eventlog Resume -> SetInterval)
//   - Daher zusätzlichen Check eingebaut ob FInterval > FMainInterval ist
//   - Bisheriger Check auf "0" geändert auf ResumeIntervalValue < 100
//     zur Vermeidung zu kleine Rest Intervallzeit bis nächsten Timer Event
//   - Kommt einer dieser beiden Fälle vor, wird FInterval zurückgesetzt
//     auf FMainInterval Wert
//---------------------------------------------------------------------------------------------------------
// 2015-08-21 - Rev.2.0.5.1
// * !WICHTIGER BUGFIX! procedure TPauseTimer.Resume:
//   - Check eingebaut of ResumeIntervalValue den Wert 0 erhält
//     ResumeIntervalValue := FInterval - (FPauseTime-FStartTime);
//     Bei "Value = 0" muss hier "Value <> 0" eingestellt werden
//     Es wird "Value := 50" eingestellt = 50msec bis nächster TimerEvent
//     Bei "Value = 0" wird der Timer NICHT mehr neu gestartet !!!
//     (Siehe "SetInterval -> UpdateTimer")
//     --> Timersteuerung bleibt dann stehen !!
//     !NACHTRAG! Das ist nicht der Grund für "eingefrorenen" Timer
//     (siehe HOT Bugfix 2015-08-26)
//---------------------------------------------------------------------------------------------------------
// 2015-08-05 - Rev.2.0.1.1
// !NEU! Dieser Timer wird ab sofort als ZENTRALER "RatePBPauseTimer" genutzt !
// TimerKomponente die mit PAUSE/RESUME angehalten werden kann
// läuft dann weiter mit dem zwischengespeicherten Wert
// Vorlage kopiert von:
// "http://www.delphipraxis.net/44768-pause-timer-setzen.html"
//========================================================================================================
unit PauseTimer;

interface

uses
  SysUtils, Classes, Windows, Forms, ExtCtrls, Messages;

type
  TPauseTimer = class(TComponent)
  private
    m_CalledFromWhere : string;
    m_CalledFromMain  : string;
    FInterval,
    FMainInterval,
    FStartTime,
    FPauseTime: Cardinal;
    FWindowHandle: HWND;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetMainInterval(Value: Cardinal);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure Timer; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Delay: Cardinal read FInterval;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Cardinal read FMainInterval write SetMainInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
    procedure Pause;
    Procedure Resume;
  end;

//procedure Register;

implementation


constructor TPauseTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FMainInterval := 1000;
  FInterval := 1000;
  FPauseTime := 0;
  FStartTime := 0;
  FWindowHandle := Classes.AllocateHWnd(WndProc);
end;

destructor TPauseTimer.Destroy;
begin
  m_CalledFromWhere := 'Destroy';
  FEnabled := False;
  UpdateTimer;
  Classes.DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TPauseTimer.WndProc(var Msg: TMessage);
begin
  with Msg do
  begin
    if Msg = WM_TIMER then
    begin
      try
        Timer;
      except
        Application.HandleException(Self);
      end;
    end else
    begin
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
    end;
  end; //with Msg
end;

procedure TPauseTimer.UpdateTimer;
const FunctionName = 'TPauseTimer.UpdateTimer';
begin
  KillTimer(FWindowHandle, 1);
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
  begin
    if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
    begin
      raise EOutOfResources.Create('Timer Error');
    end;
    FStartTime:=GetTickCount;
  end;
end;

procedure TPauseTimer.SetEnabled(Value: Boolean);
begin
  m_CalledFromWhere := m_CalledFromMain + ' -> SetEnabled';
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    UpdateTimer;
  end;
end;

procedure TPauseTimer.SetInterval(Value: Cardinal);
begin
  m_CalledFromWhere := m_CalledFromMain + ' -> SetInterval';
  if Value <> FInterval then
  begin
    FInterval := Value;
    UpdateTimer;
  end;
end;

procedure TPauseTimer.SetMainInterval(Value: Cardinal);
begin
  FMainInterval := Value;
  FPauseTime := 0;
  m_CalledFromMain := 'SetMainInterval';
  SetInterval(Value);
  m_CalledFromMain := 'N/A';
end;

procedure TPauseTimer.SetOnTimer(Value: TNotifyEvent);
begin
  m_CalledFromWhere := 'SetOnTimer';
  FOnTimer := Value;
  UpdateTimer;
end;

procedure TPauseTimer.Timer;
begin
  m_CalledFromWhere := 'Timer';
  if Assigned(FOnTimer) then
  begin
    FInterval:=FMainInterval;
    FOnTimer(Self);
    UpdateTimer;
  end;
end;

procedure TPauseTimer.Pause;
begin
  if not FEnabled then Exit;
  FPauseTime:=GetTickCount;
  m_CalledFromMain := 'Pause';
  SetEnabled(False);
  m_CalledFromMain := 'N/A';
end;

procedure TPauseTimer.Resume;
const FunctionName = 'TPauseTimer.Resume';
var ResumeIntervalValue : Cardinal;
begin
  if FEnabled then Exit;
  if FPauseTime <> 0 then
  begin
    ResumeIntervalValue := FInterval - (FPauseTime-FStartTime);
    //******************************************************************************
    // !BUGFIX! Bei "Value = 0" muss "Value <> 0" eingestellt werden
    // Sonst wird in "SetInterval -> UpdateTimer" der Timer NICHT mehr gestartet !!!
    // RTHA 2015-08-25 - Check geändert "Value = 0" ==> "Value < 100"
    // Vermeidung zu kleine Rest Intervallzeit bis nächsten Timer Event
    // ResumeIntervalValue := 100 --> 100 msec bis nächsten Timer Event
    //******************************************************************************
    // !BUGFIX! 2. Ursache für "eingefrorenen" Timer gefunden
    // ResumeIntervalValue wird sporadisch mit Wert $ FFFF FFF<x> (Hex) belegt ??!!
    // Timer wird zwar wieder gestartet jedoch mit dieser extrem langen Laufzeit
    // Damit Eindruck eingefrorener Zustand !!!
    // Typ Cardinal = 32 Bit OHNE Vorzeichen !
    // Check eingebaut of ResumeIntervalValue > FMainInterval geworden ist
    // --> Dann ResumeIntervalValue auf FMainInterval setzen
    //******************************************************************************
    if (ResumeIntervalValue < 100) or
       (ResumeIntervalValue > FMainInterval) then
    begin
      ResumeIntervalValue := FMainInterval; // !! RESET auf FMainInterval Wert !!
    end;
    m_CalledFromMain := 'Resume';
    SetInterval(ResumeIntervalValue); // FEnabled ist hier noch "FALSE" bei vorheriger PAUSE
    m_CalledFromMain := 'N/A';
    FPauseTime:=0;
  end;
  m_CalledFromMain := 'Resume';
  SetEnabled(True);
  m_CalledFromMain := 'N/A';
end;

//procedure Register;
//begin
//  RegisterComponents('User Tools', [TPauseTimer]);
//end;

end.

[Monday]

Hätte man nicht auch mit einem zweiten Timer arbeiten können? Wenn der erste Pausieren soll, dann wird Timer1 deaktiviert, Timer2 (Pausentimer) aktiviert und nach abgelaufender Zeit deaktiviert sich Timer2 selbst und aktiviert Timer 1 wieder. ?

[Blup]

UpdateTimer sollte vor FOnTimer() aufgerufen werden, sonst verfälschen lange Laufzeiten der OnTimer-Methode die Genauigkeit.

Delphi-Quellcode:

    UpdateTimer;
    FOnTimer(Self);

Da Windows-PCs manchmal auch über mehrere Tage laufen, besser mit GetTickCount64() arbeiten.
http://www.delphipraxis.net/711170-post5.html

[Glados]

Von welcher Beschränkung genau sprichst du?

Meinst du, dass man Dax's GetTickCount64-Code auch unter XP verwenden kann? Kann man Winapi.Windows.GetTickCount64 nicht unter XP verwenden?