jvtimerlist.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvTimerList.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Contributor(s):
- (p3) Rewritten to use TCollectionItem instead of TComponent for TJvTimerItem
  Change this in your own code:
  * CreateNewEvent -> Events.Add
  * AddItem -> Events.Add and then read the Item.Handle property
  * NextHandle -> Events.NextHandle
  * Delete() -> Events.DeleteByHandle()
  * IndexFromHandle -> Events.IndexFromHandle
  * ItemIndexByHandle -> Events.ItemIndexByHandle
  * Sort -> Events.Sort
  * EnabledCount -> Events.EnabledCount
  Additionally, if you cast Events[Index] to TComponent somewhere, you will have to
  change/remove it
  NOTE
    If you are using this component, the saved values in the dfm won't work. You can
    set them up again after loading the project, but you can also open your dfm
    in Notepad (assuming you have saved it as text, which you should), load the
    project into Delphi, ignore all warnings and then copy and paste from notepad
    to the Collection Editor for the Events property.

Known Issues:

-----------------------------------------------------------------------------}
// $Id: JvTimerList.pas,v 1.39 2005/03/09 14:57:31 marquardt Exp $

unit JvTimerList;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, SysUtils, Classes;

const
  DefaultInterval = 1000;

type
  TAllTimersEvent = procedure(Sender: TObject; Handle: Longint) of object;

  TJvTimerEvent = class;
  TJvTimerList = class;
  {$IFDEF COMPILER5}
  TCollectionNotification = (cnAdded, cnDeleted);
  {$ENDIF COMPILER5}

  // (rom) used THandle where needed
  TJvTimerEvents = class(TOwnedCollection)
  private
    FInterval: Longint;
    FStartInterval: Longint;
    FSequence: Longint;
    FParent: TJvTimerList;
    function GetEnabledCount: Integer;
    function GetItem(Index: Integer): TJvTimerEvent;
    procedure SetItem(Index: Integer; const Value: TJvTimerEvent);
  protected
    procedure CalculateInterval(StartTicks: Longint);
    procedure UpdateEvents(StartTicks: Longint);
    function ProcessEvents: Boolean;
    procedure Notify(Item: TCollectionItem; Action: TCollectionNotification);
      {$IFDEF COMPILER6_UP} override; {$ENDIF}
    {$IFDEF COMPILER5}
    function Owner: TPersistent;
    {$ENDIF COMPILER5}
  public
    constructor Create(AOwner: TPersistent);
    procedure Activate;
    function Add: TJvTimerEvent;
    procedure Deactivate;
    procedure DeleteByHandle(AHandle: THandle); virtual;
    function ItemByHandle(AHandle: THandle): TJvTimerEvent;
    function ItemIndexByHandle(AHandle: THandle): Integer;
    function IndexOfName(const AName: string): Integer;
    function ItemByName(const AName: string): TJvTimerEvent;
    function NextHandle: THandle;
    procedure Sort;
    procedure Assign(Source: TPersistent); override;
    property Items[Index: Integer]: TJvTimerEvent read GetItem write SetItem; default;
    property EnabledCount: Integer read GetEnabledCount;
  end;

  TJvTimerEvent = class(TCollectionItem)
  private
    FCycled: Boolean;
    FEnabled: Boolean;
    FExecCount: Integer;
    FHandle: THandle;
    FInterval: Longint;
    FLastExecute: Longint;
    FParentList: TJvTimerList;
    FRepeatCount: Integer;
    FOnTimer: TNotifyEvent;
    FName: string;
    function GetAsSeconds: Cardinal;
    procedure SetAsSeconds(Value: Cardinal);
    procedure SetRepeatCount(Value: Integer);
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Longint);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;

    property AsSeconds: Cardinal read GetAsSeconds write SetAsSeconds;
    property Handle: THandle read FHandle;
    property ExecCount: Integer read FExecCount;
    property TimerList: TJvTimerList read FParentList;
    procedure Assign(Source: TPersistent); override;
  published
    property Name: string read FName write FName;
    property Cycled: Boolean read FCycled write FCycled default True;
    property RepeatCount: Integer read FRepeatCount write SetRepeatCount default 0;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Longint read FInterval write SetInterval default DefaultInterval;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;

  TJvTimerList = class(TComponent)
  private
    FEvents: TJvTimerEvents;
    FWndHandle: HWND;
    FOnFinish: TNotifyEvent;
    FOnTimers: TAllTimersEvent;
    FActive: Boolean;
    FSorted: Boolean;
    procedure TimerWndProc(var Msg: TMessage);
    procedure UpdateTimer;
    procedure SetEvents(const Value: TJvTimerEvents);
    procedure SetActive(Value: Boolean);
    procedure SetSorted(const Value: Boolean);
  protected
    procedure DoTimer(Event: TJvTimerEvent); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Add(AOnTimer: TNotifyEvent; AInterval: Longint;
      ACycled: Boolean): THandle; virtual;
  published
    property Active: Boolean read FActive write SetActive default False;
    property Events: TJvTimerEvents read FEvents write SetEvents;
    // NB! Setting sorted to true means that the index of the Events are changed!!!
    property Sorted: Boolean read FSorted write SetSorted default False;
    property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
    property OnTimers: TAllTimersEvent read FOnTimers write FOnTimers;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvTimerList.pas,v $';
    Revision: '$Revision: 1.39 $';
    Date: '$Date: 2005/03/09 14:57:31 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Consts,
  Forms, // for Application.HandleException
  Math,
  JvJVCLUtils, JvResources, JvTypes;

const
  MinInterval = 100; { 0.1 sec }
  MaxTimerInterval: Longint = High(Longint);

//=== { TJvTimerEvent } ======================================================

constructor TJvTimerEvent.Create(ACollection: TCollection);
begin
  FHandle := INVALID_HANDLE_VALUE;
  inherited Create(ACollection);
  {$IFDEF COMPILER5}
  (GetOwner as TJvTimerEvents).Notify(Self, cnAdded); // invoke missing Notify
  {$ENDIF COMPILER5}
  FCycled := True;
  FRepeatCount := 0;
  FEnabled := True;
  FExecCount := 0;

  // Do not set FInterval directly or the timer would never trigger
  // if its Interval is left to its default value. This is because
  // the default value for Enabled is True. If it were False, then
  // the user would have to set Enable to True and thus trigger the
  // creation of the timer.
  Interval := DefaultInterval;
  
  FLastExecute := GetTickCount;
end;

destructor TJvTimerEvent.Destroy;
begin
  FOnTimer := nil;
  {$IFDEF COMPILER5}
  (GetOwner as TJvTimerEvents).Notify(Self, cnDeleted); // invoke missing Notify
  {$ENDIF COMPILER5}
  inherited Destroy;
end;

procedure TJvTimerEvent.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    if FEnabled then
    begin
      FExecCount := 0;
      FLastExecute := GetTickCount;
      if FParentList <> nil then
        with FParentList do
        begin
          Events.CalculateInterval(GetTickCount);
          UpdateTimer;
          Events.Activate;
        end;
    end;
  end;
end;

procedure TJvTimerEvent.SetInterval(Value: Longint);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    if FParentList <> nil then
      with FParentList do
      begin
        Events.CalculateInterval(GetTickCount);
        UpdateTimer;
      end;
  end;
end;

procedure TJvTimerEvent.SetRepeatCount(Value: Integer);
begin
  if FRepeatCount <> Value then
  begin
    Value := Max(Value, Integer(not FCycled));
    if not (csDesigning in FParentList.ComponentState) then
      if FEnabled and (Value <= FExecCount) then
        Enabled := False;
    FRepeatCount := Value;
  end;
end;

function TJvTimerEvent.GetAsSeconds: Cardinal;
begin
  Result := Interval div 1000;
end;

procedure TJvTimerEvent.SetAsSeconds(Value: Cardinal);
begin
  Interval := Value * 1000;
end;

procedure TJvTimerEvent.Assign(Source: TPersistent);
begin
  if Source is TJvTimerEvent then
  begin
    if Source <> Self then
    begin
      Cycled := TJvTimerEvent(Source).Cycled;
      Enabled := TJvTimerEvent(Source).Enabled;
      Interval := TJvTimerEvent(Source).Interval;
      Name := TJvTimerEvent(Source).Name;
      RepeatCount := TJvTimerEvent(Source).RepeatCount;
    end;
  end
  else
    inherited Assign(Source);
end;

//=== { TJvTimerList } =======================================================

constructor TJvTimerList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEvents := TJvTimerEvents.Create(Self);
  FWndHandle := INVALID_HANDLE_VALUE;
  Events.Deactivate;
end;

destructor TJvTimerList.Destroy;
begin
  OnFinish := nil;
  OnTimers := nil;
  Events.Deactivate;
  Events.Clear;
  FEvents.Free;
  inherited Destroy;
end;

{ Create a new timer event and returns a handle }

function TJvTimerList.Add(AOnTimer: TNotifyEvent; AInterval: Longint;
  ACycled: Boolean): THandle;
var
  T: TJvTimerEvent;
begin
  T := Events.Add;
  T.FParentList := Self;
  with T do
  begin
    OnTimer := AOnTimer;
    FParentList := Self;
    FHandle := Events.NextHandle;
    Interval := AInterval;
    Cycled := ACycled;
    Result := FHandle;
  end;
  Events.CalculateInterval(GetTickCount);
  if Sorted then
    Events.Sort;
  UpdateTimer;
end;

procedure TJvTimerList.TimerWndProc(var Msg: TMessage);
begin
  if not (csDesigning in ComponentState) then
  begin
    with Msg do
      if Msg = WM_TIMER then
      try
        if (not (csDesigning in ComponentState)) and
          (Events.FStartInterval = 0) and Active then
        begin
          if Events.ProcessEvents then
          begin
            if Events.EnabledCount = 0 then
              Events.Deactivate
            else
            begin
              Events.CalculateInterval(GetTickCount);
              UpdateTimer;
            end;
          end;
        end
        else
          UpdateTimer;
      except
        {$IFDEF VCL}
        Application.HandleException(Self);