Results 1 to 13 of 13

Thread: SuperTimer

  1. #1

    SuperTimer

    Zoek je nog een top Timer hier is het antwoord.
    Deze is echt snel en goed. Maakt niet uit hoe vaak je deze aanroept.
    Even een uitleg: De echte spel HIRES timers zijn beter maar dat geeft een conflict met de normale Timers.
    Groetjes.

    Code:
    {------------------------------------------------------------------------------}
    {                                                                              }
    {  TRealArtTimer                                                               }
    {  Komt uit TRealTimeMarquee    
    { Edit by Eduard }                                               }
    {                                                                              }
    {------------------------------------------------------------------------------}
    
    unit RealArtTimer;
    
    interface
    
    uses
      Winapi.Messages, Winapi.Windows, System.Classes, Winapi.mmSystem;
    
    type
      TRealArtTimer = class(TObject)
      private
        FActive: Boolean;
        FInterval: Cardinal;
        FOnTimer: TNotifyEvent;
        Resolution: Cardinal;
        TimerID: Cardinal;
        CS: TRTLCriticalSection;
        TimeCaps: TTimeCaps;
        procedure SetActive(Value: Boolean);
        procedure SetInterval(Value: Cardinal);
      private
        procedure StartTimer;
        procedure StopTimer;
        procedure CheckTimer;
        procedure StepIt;
      public
        constructor Create;
        destructor Destroy; override;
        function TryLock: Boolean;
        procedure Lock;
        procedure Unlock;
        property Active: Boolean read FActive write SetActive default False;
        property Interval: Cardinal read FInterval write SetInterval default 10;
        property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
      end;
    
    implementation
    
    { Timer Callback Function }
    
    procedure TimerProc(uTimerID, uMessage, dwUser, dw1, dw2: DWORD); stdcall;
    begin
      TRealArtTimer(dwUser).StepIt;
    end;
    
    { TRealArtTimer }
    
    constructor TRealArtTimer.Create;
    begin
      inherited Create;
      InitializeCriticalSection(CS);
      timeGetDevCaps(@TimeCaps, SizeOf(TTimeCaps));
      Interval := 10;
    end;
    
    destructor TRealArtTimer.Destroy;
    begin
      FOnTimer := nil;
      StopTimer;
      DeleteCriticalSection(CS);
      inherited Destroy;
    end;
    
    procedure TRealArtTimer.SetActive(Value: Boolean);
    begin
      if (FActive <> Value) then
      begin
        Lock;
        try
          FActive := Value;
          CheckTimer;
        finally
          Unlock;
        end;
      end;
    end;
    
    procedure TRealArtTimer.SetInterval(Value: Cardinal);
    begin
      if Value < TimeCaps.wPeriodMin then
        Value := TimeCaps.wPeriodMin
      else if Value > TimeCaps.wPeriodMax then
        Value := TimeCaps.wPeriodMax;
      if Interval <> Value then
      begin
        StopTimer;
        FInterval := Value;
        Resolution := Interval div 10;
        if Resolution < TimeCaps.wPeriodMin then
          Resolution := TimeCaps.wPeriodMin;
        CheckTimer;
      end;
    end;
    
    procedure TRealArtTimer.StepIt;
    begin
      if not TryLock then
        Exit;
      try
        if (TimerID = 0) then
          Exit;
    
        if Assigned(FOnTimer) then
          FOnTimer(Self);
    
      finally
        Unlock;
      end;
    end;
    
    procedure TRealArtTimer.StartTimer;
    begin
      Lock;
      try
        if (TimerID = 0) then
        begin
          timeBeginPeriod(Resolution);
          TimerID := timeSetEvent(Interval, Resolution, @TimerProc, DWORD(Self), TIME_PERIODIC);
        end;
      finally
        Unlock;
      end;
    end;
    
    procedure TRealArtTimer.StopTimer;
    begin
      Lock;
      try
        if TimerID <> 0 then
        begin
          timeKillEvent(TimerID);
          timeEndPeriod(Resolution);
          TimerID := 0;
        end;
      finally
        Unlock;
      end;
    end;
    
    procedure TRealArtTimer.CheckTimer;
    begin
      if (FActive) then
        StartTimer
      else
        StopTimer;
    end;
    
    function TRealArtTimer.TryLock: Boolean;
    begin
      Result := TryEnterCriticalSection(CS);
    end;
    
    procedure TRealArtTimer.Lock;
    begin
      EnterCriticalSection(CS);
    end;
    
    procedure TRealArtTimer.Unlock;
    begin
      LeaveCriticalSection(CS);
    end;
    
    end.

  2. #2
    Waarom is deze zo goed? Wat doet hij beter dan andere timers?
    Hij maakt in ieder geval gebruik van timeSetEvent, die obsolete is volgens Microsoft, en waarvoor je beter CreateTimerQueueTimer kan gebruiken.
    1+1=b

  3. #3
    Deze was eigenlijk de beste voor WAVE weergave dus ik dacht deel het even.

    Obsolete was ik vergeten dus zal eens een keer kijken naar CreateTimerQueueTimer als dat niet te moeilijk is.

    Gebruik het of gebruik het niet

  4. #4
    Werkt goed hoor onder W11. Zie geen reden om dit te veranderen.
    Depricated voor wat?
    Groetjes.

  5. #5
    Ja, dat weet ik ook niet. De documentatie zegt dat. Misschien zijn er plannen om 'm in een volgende versie te verwijderen.
    1+1=b

  6. #6
    Dat zou goed kunnen. Ik ga dan maar eens op een regenachtige zondagmiddag wat proberen.

  7. #7
    Quote Originally Posted by DragonFly View Post
    Dat zou goed kunnen. Ik ga dan maar eens op een regenachtige zondagmiddag wat proberen.
    Zijn gewoon wat voorbeelden van. Hier de basis unit van een KsTimer:
    Mijn TUniTimer stampt hier vanaf met wel een aantal verbouwingen/toevoegingen/beveiligingen, maar met dit voorbeeldje kan je denk ik ook wel uit de voeten om de CreateTimerQueueTimer te implementeren.


    Code:
    { *********************************************************** }
    { *                    ksTools Library                      * }
    { *       Copyright (c) Sergey Kasandrov 1997, 2010         * }
    { *       -----------------------------------------         * }
    { *         http://sergworks.wordpress.com/kstools          * }
    { *********************************************************** }
    
    unit ksTimers;
    
    
    interface
    
    uses
      Windows, Messages, SysUtils, Classes, Forms;
    
    type
      TksTimer = class(TComponent)
      private
        FDueTime: Cardinal;
        FPeriod: Cardinal;
        FTimerHandle: THandle;
        FWindowHandle: HWND;
        FThreadCount: Cardinal;
        FCount: Cardinal;
        FOnTimer: TNotifyEvent;
        FEnabled: Boolean;
        procedure SetEnabled(Value: Boolean);
        procedure WndProc(var Msg: TMessage);
        procedure SetDueTime(const Value: Cardinal);
        procedure SetPeriod(const Value: Cardinal);
      protected
        procedure Timer; virtual;
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        property Count: Cardinal read FCount;
      published
        property Enabled: Boolean read FEnabled write SetEnabled default False;
        property DueTime: Cardinal read FDueTime write SetDueTime default 1000;
        property Period: Cardinal read FPeriod write SetPeriod default 1000;
        property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
      end;
    
    type
      TWaitOrTimerCallback = procedure(lpParameter: Pointer; TimerOrWaitFired: Boolean); stdcall;
    
    function CreateTimerQueueTimer(
      var Timer: THandle;
      TimerQueue: THandle;
      Callback: TWaitOrTimerCallback;
      Parameter: Pointer;
      DueTime: LongWord;
      Period: LongWord;
      Flags: LongWord
      ): BOOL; stdcall;
    
    function DeleteTimerQueueTimer(
      TimerQueue: THandle;
      Timer: THandle;
      CompletionEvent: THandle
      ): BOOL; stdcall;
    
    implementation
    
    function CreateTimerQueueTimer; external kernel32 name 'CreateTimerQueueTimer';
    function DeleteTimerQueueTimer; external kernel32 name 'DeleteTimerQueueTimer';
    
    procedure TimerCallback(Timer: TksTimer; TimerOrWaitFired: Boolean); stdcall;
    begin
      Inc(Timer.FThreadCount);
      PostMessage(Timer.FWindowHandle, WM_APP + 1, 0, Timer.FThreadCount);
    end;
    
    { TksTimer }
    
    constructor TksTimer.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      FDueTime:= 1000;
      FPeriod:= 1000;
      FWindowHandle:= Classes.AllocateHWnd(WndProc);
    end;
    
    destructor TksTimer.Destroy;
    begin
      SetEnabled(False);
      Classes.DeallocateHWnd(FWindowHandle);
      inherited Destroy;
    end;
    
    procedure TksTimer.WndProc(var Msg: TMessage);
    begin
      with Msg do
        if Msg = WM_APP + 1 then begin
          FCount:= lParam;
          try
            Timer;
          except
            Application.HandleException(Self);
          end
        end
        else
          Result:= DefWindowProc(FWindowHandle, Msg, wParam, lParam);
    end;
    
    procedure TksTimer.SetEnabled(Value: Boolean);
    begin
      if Value <> FEnabled then
      begin
        if Value then
        begin
          FThreadCount:= 0;
          FCount:= 0;
          FEnabled:= CreateTimerQueueTimer(FTimerHandle, 0, @TimerCallback, Self, FDueTime, FPeriod, 0);
        end
        else
        begin
          DeleteTimerQueueTimer(0, FTimerHandle, 0);
          FEnabled:= False;
        end;
      end;
    end;
    
    procedure TksTimer.SetDueTime(const Value: Cardinal);
    begin
      if not FEnabled then
        FDueTime:= Value;
    end;
    
    procedure TksTimer.SetPeriod(const Value: Cardinal);
    begin
      if not FEnabled then
        FPeriod:= Value;
    end;
    
    procedure TksTimer.Timer;
    begin
      if Assigned(FOnTimer) then FOnTimer(Self);
    end;
    
    end.
    Alvast bedankt, Patrick

  8. #8
    Dat is nou net toevallig want ik had deze vanmiddag opgezocht en aangepast (uitgekleed) naar mijn wensen.
    De origineel werkte niet in mijn programma wat komt door de 'PostMessage' en misschien nog meer.

    Als het nog even mag hier in de Koffie?
    Een klein vraagje nog. In mijn vorige source maken ze gebruik van InitializeCriticalSection (die heb ik laten staan) wat toch alleen nodig is als ik de Timers in een Thread gebruikt?
    Dit is wat ik begreep bij Google search.

    Bedankt voor het meedenken.
    Hier mijn source. Werkt prima tot zover.

    Code:
    unit ksTimers;
    
    interface
    
    uses
      Winapi.Windows, System.Classes;
    
    type
      TksTimer = class(TObject)
      private
        FDueTime: Cardinal;
        FInterval: Cardinal;
        FTimerHandle: THandle;
        FOnTimer: TNotifyEvent;
        FActive: Boolean;
        procedure SetActive(Value: Boolean);
        procedure SetDueTime(const Value: Cardinal);
        procedure SetInterval(const Value: Cardinal);
        procedure StepIt;
      public
        constructor Create;
        destructor Destroy; override;
        property Active: Boolean read FActive write SetActive default False;
        property DueTime: Cardinal read FDueTime write SetDueTime default 100;
        property Interval: Cardinal read FInterval write SetInterval default 10;
        property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
      end;
    
    implementation
    
    procedure TimerCallback(Timer: TksTimer; TimerOrWaitFired: Boolean); stdcall;
    begin
      Timer.StepIt;
    end;
    
    { TksTimer }
    
    constructor TksTimer.Create;
    begin
      inherited Create;
      FDueTime := 100;
      FInterval := 10;
    end;
    
    destructor TksTimer.Destroy;
    begin
      SetActive(False);
      inherited Destroy;
    end;
    
    procedure TksTimer.SetActive(Value: Boolean);
    begin
      if Value <> FActive then
      begin
        if Value then
        begin
          FActive := CreateTimerQueueTimer(FTimerHandle, 0, @TimerCallback, Self, FDueTime, FInterval, 0);
        end
        else
        begin
          DeleteTimerQueueTimer(0, FTimerHandle, 0);
          FActive := False;
        end;
      end;
    end;
    
    procedure TksTimer.SetDueTime(const Value: Cardinal);
    begin
      if not FActive then
        FDueTime := Value;
    end;
    
    procedure TksTimer.SetInterval(const Value: Cardinal);
    begin
      if not FActive then
        FInterval := Value;
    end;
    
    procedure TksTimer.StepIt;
    begin
      if Assigned(FOnTimer) then
        FOnTimer(Self);
    end;
    
    end.

  9. #9
    Niet alleen timers, hoor . De timer is op zich al een 'thread' met CreateTimerQueueTimer, die met een callback wat kan 'aansturen' Hier een heel verhaal erover(mbt tot criticalsection):https://wikiwebpedia.com/tcriticalsection-delphi

    Vooral met audio/video waar jij en ik mee bezig zijn, is threading best een must have. Al zijn er natuurlijk nog veel zaken te bedenken waarbij threading een must have is(File I/O, TCP e.t.c).

    P.S. Ik ben niet zo goed in uitleggen van zaken, dus wellicht dat iemand dat wel kan
    Last edited by Patjuh; 01-Aug-22 at 16:34.
    Alvast bedankt, Patrick

  10. #10
    Het linkje maakt het een en ander wel duidelijk. T.z.t eens wat units bekijken en/of herzien. Ik kom er wel uit.

  11. #11
    Quote Originally Posted by DragonFly View Post
    Het linkje maakt het een en ander wel duidelijk. T.z.t eens wat units bekijken en/of herzien. Ik kom er wel uit.
    Top. Ik kan het alleen heel technisch uitleggen en niet echt in 'normale taal', haha!. Ik ga de source-code van mijn radio-playout systeem niet posten; dat vind ik lastig en zoveel code in een keer is ook niet echt 'leerbaar', maar wellicht zou je er een kijkje in kunnen nemen met #koffie of een toekomstige #NLDelphiDay ofzo-iets.
    Alvast bedankt, Patrick

  12. #12
    Ik vind het prima zo
    Ik gebruik deze timer om de WAVE voortgang vloeiender te maken. Dat gaat goed.

  13. #13
    Bedankt trouwens Patrick. Woon in Vlissingen en dan is #Koffie erg ver denk ik.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •