timerlst.pas

rxlib2.75控件包

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1997 Master-Bank                }
{                                                       }
{*******************************************************}

unit TimerLst;

{$I RX.INC}

interface

uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Messages, Classes;

const
  DefaultInterval = 1000;
  HInvalidEvent = -1;

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

  TRxTimerEvent = class;

  TRxTimerList = class(TComponent)
  private
    FEvents: TList;
    FWndHandle: hWnd;
    FActive: Boolean;
    FInterval: Longint;
    FSequence: Longint;
    FStartInterval: Longint;
    FOnFinish: TNotifyEvent;
    FOnTimers: TAllTimersEvent;
    procedure CalculateInterval(StartTicks: Longint);
    function CreateNewEvent: TRxTimerEvent;
    function GetCount: Integer;
    function GetEnabledCount: Integer;
    function ProcessEvents: Boolean;
    procedure RemoveItem(Item: TRxTimerEvent);
    procedure SetActive(Value: Boolean);
    procedure SetEvents(StartTicks: Longint);
    procedure Sort;
    procedure TimerWndProc(var Msg: TMessage);
    procedure UpdateTimer;
  protected
{$IFDEF WIN32}
    procedure GetChildren(Proc: TGetChildProc {$IFDEF RX_D3};
      Root: TComponent {$ENDIF}); override;
{$ELSE}
    procedure WriteComponents(Writer: TWriter); override;
{$ENDIF WIN32}
    procedure DoTimer(Event: TRxTimerEvent); dynamic;
    function NextHandle: Longint; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Add(AOnTimer: TNotifyEvent; AInterval: Longint;
      ACycled: Boolean): Longint; virtual;
    function AddItem(Item: TRxTimerEvent): Longint;
    procedure Clear;
    procedure Delete(AHandle: Longint); virtual;
    procedure Activate;
    procedure Deactivate;
    function ItemByHandle(AHandle: Longint): TRxTimerEvent;
    function ItemIndexByHandle(AHandle: Longint): Integer;
    property Count: Integer read GetCount;
    property EnabledCount: Integer read GetEnabledCount;
  published
    property Active: Boolean read FActive write SetActive default False;
    property Events: TList read FEvents;
    property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
    property OnTimers: TAllTimersEvent read FOnTimers write FOnTimers;
  end;

  TRxTimerEvent = class(TComponent)
  private
    FCycled: Boolean;
    FEnabled: Boolean;
    FExecCount: Integer;
    FHandle: Longint;
    FInterval: Longint;
    FLastExecute: Longint;
    FParentList: TRxTimerList;
    FRepeatCount: Integer;
    FOnTimer: TNotifyEvent;
    function GetAsSeconds: Cardinal;
    procedure SetAsSeconds(Value: Cardinal);
    procedure SetRepeatCount(Value: Integer);
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Longint);
{$IFNDEF WIN32}
    procedure SetParentList(Value: TRxTimerList);
{$ENDIF WIN32}
  protected
{$IFDEF WIN32}
    procedure SetParentComponent(Value: TComponent); override;
{$ELSE}
    procedure ReadState(Reader: TReader); override;
{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function HasParent: Boolean; override;
{$IFDEF WIN32}
    function GetParentComponent: TComponent; override;
{$ENDIF}
    property AsSeconds: Cardinal read GetAsSeconds write SetAsSeconds;
    property Handle: Longint read FHandle;
    property ExecCount: Integer read FExecCount;
    property TimerList: TRxTimerList read FParentList;
  published
    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;

implementation

uses Consts, Controls, Forms, SysUtils, VCLUtils, MaxMin;

const
  MinInterval = 100; { 0.1 sec }
{$IFDEF RX_D4}
  MaxTimerInterval: Longint = High(Longint);
{$ELSE}
  MaxTimerInterval: Longint = High(Cardinal);
{$ENDIF}
{$IFNDEF WIN32}
  INVALID_HANDLE_VALUE = 0;
{$ENDIF}
  Registered: Boolean = False;

{ TRxTimerEvent }

constructor TRxTimerEvent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FParentList := nil;
  FCycled := True;
  FRepeatCount := 0;
  FEnabled := True;
  FExecCount := 0;
  FInterval := DefaultInterval;
  FLastExecute := GetTickCount;
  FHandle := HInvalidEvent;
end;

destructor TRxTimerEvent.Destroy;
begin
  FOnTimer := nil;
  inherited Destroy;
end;

{$IFNDEF WIN32}
procedure TRxTimerEvent.SetParentList(Value: TRxTimerList);
begin
  if FParentList <> nil then FParentList.RemoveItem(Self);
  if Value <> nil then Value.AddItem(Self);
end;
{$ENDIF}

function TRxTimerEvent.HasParent: Boolean;
begin
  Result := True;
end;

{$IFDEF WIN32}

function TRxTimerEvent.GetParentComponent: TComponent;
begin
  Result := FParentList;
end;

procedure TRxTimerEvent.SetParentComponent(Value: TComponent);
begin
  if FParentList <> nil then FParentList.RemoveItem(Self);
  if (Value <> nil) and (Value is TRxTimerList) then
    TRxTimerList(Value).AddItem(Self);
end;

{$ELSE}

procedure TRxTimerEvent.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TRxTimerList then
    SetParentList(TRxTimerList(Reader.Parent));
end;

{$ENDIF WIN32}

procedure TRxTimerEvent.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
          CalculateInterval(GetTickCount);
          UpdateTimer;
        end;
    end;
  end;
end;

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

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

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

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

{ TRxTimerList }

constructor TRxTimerList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEvents := TList.Create;
  FWndHandle := INVALID_HANDLE_VALUE;
  FSequence := 0;
  FStartInterval := 0;
  Deactivate;
  if not Registered then begin
    RegisterClasses([TRxTimerEvent]);
    Registered := True;
  end;
end;

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

procedure TRxTimerList.Activate;
begin
  Active := True;
end;

procedure TRxTimerList.Deactivate;
begin
  if not (csLoading in ComponentState) then Active := False;
end;

procedure TRxTimerList.SetEvents(StartTicks: Longint);
var
  I: Integer;
begin
  for I := 0 to FEvents.Count - 1 do
    if TRxTimerEvent(FEvents[I]).Enabled then
      TRxTimerEvent(FEvents[I]).FLastExecute := StartTicks;
end;

procedure TRxTimerList.SetActive(Value: Boolean);
var
  StartTicks: Longint;
begin
  if FActive <> Value then begin
    if not (csDesigning in ComponentState) then begin
      if Value then begin
        FWndHandle := Classes.AllocateHWnd(TimerWndProc);