jvqtimerlist.pas

East make Tray Icon in delphi

procedure TJvTimerList.UpdateTimer;
var
  TimerInterval: Cardinal;
begin
  if not (csDesigning in ComponentState) then
  begin
    if Events.FInterval <= MaxTimerInterval then
      TimerInterval := Events.FInterval
    else
    if (Events.FInterval - Events.FStartInterval) <= MaxTimerInterval then
    begin
      TimerInterval := Cardinal(Events.FInterval - Events.FStartInterval);
      Events.FStartInterval := 0;
    end
    else
    begin
      TimerInterval := MaxTimerInterval;
      Events.FStartInterval := Events.FStartInterval + MaxTimerInterval;
    end;
    if not (csDesigning in ComponentState) and (FWndHandle <> INVALID_HANDLE_VALUE) then
    begin
      KillTimer(FWndHandle, 1);
      if Events.EnabledCount = 0 then
        Events.Deactivate
      else
      if Events.FInterval > 0 then
        if SetTimer(FWndHandle, 1, TimerInterval, nil) = 0 then
        begin
          Events.Deactivate;
          raise EOutOfResources.CreateRes(@SNoTimers);
        end;
    end;
  end;
end;

procedure TJvTimerList.SetEvents(const Value: TJvTimerEvents);
begin
  FEvents.Assign(Value);
end;

procedure TJvTimerList.SetActive(Value: Boolean);
var
  StartTicks: Longint;
begin
  if FActive <> Value then
  begin
    if not (csDesigning in ComponentState) then
    begin
      if Value then
      begin
        FWndHandle := AllocateHWndEx(TimerWndProc);
        StartTicks := GetTickCount;
        Events.UpdateEvents(StartTicks);
        Events.CalculateInterval(StartTicks);
        if Sorted then
          Events.Sort;
        UpdateTimer;
      end
      else
      begin
        KillTimer(FWndHandle, 1);
        DeallocateHWndEx(FWndHandle);
        FWndHandle := INVALID_HANDLE_VALUE;
        if Assigned(FOnFinish) then
          FOnFinish(Self);
      end;
      Events.FStartInterval := 0;
    end;
    FActive := Value;
  end;
end;

procedure TJvTimerList.DoTimer(Event: TJvTimerEvent);
begin
  with Event do
    if Assigned(FOnTimer) then
      FOnTimer(Event);
  if Assigned(FOnTimers) then
    FOnTimers(Self, Event.Handle);
end;

//===TJvTimerEvents ==========================================================

constructor TJvTimerEvents.Create(AOwner: TPersistent);
begin
  if not (AOwner is TJvTimerList) then
    raise EJVCLException.CreateRes(@RsEOwnerMustBeTJvTimerList);
  inherited Create(AOwner, TJvTimerEvent);
  FParent := TJvTimerList(AOwner);
end;



procedure TJvTimerEvents.Activate;
begin
  FParent.Active := True;
end;

function TJvTimerEvents.Add: TJvTimerEvent;
begin
  Result := TJvTimerEvent(inherited Add); 
end;

procedure TJvTimerEvents.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TJvTimerEvents then
  begin
    Clear;
    for I := 0 to TJvTimerEvents(Source).Count - 1 do
      Add.Assign(TJvTimerEvents(Source).Items[I]);
  end
  else
    inherited Assign(Source);
end;

procedure TJvTimerEvents.CalculateInterval(StartTicks: Integer);
var
  I: Integer;
  ExitLoop: Boolean;
begin
  if not (csDesigning in (Owner as TJvTimerList).ComponentState) then
  begin
    if Count = 0 then
      FInterval := 0
    else
    begin
      FStartInterval := 0;
      FInterval := MaxLongint;
      for I := 0 to Count - 1 do
        with Items[I] do
          if Enabled and (Interval > 0) then
          begin
            if Interval < Self.FInterval then
              Self.FInterval := Interval;
            if Self.FInterval > (Interval - (StartTicks - FLastExecute)) then
              Self.FInterval := (Interval - (StartTicks - FLastExecute));
          end;
      if FInterval < MinInterval then
        FInterval := MinInterval;
      if FInterval = MaxLongint then
        FInterval := 0
      else
      begin
        repeat
          ExitLoop := True;
          for I := 0 to Count - 1 do
            with Items[I] do
              if (Interval mod Self.FInterval) <> 0 then
              begin
                Dec(Self.FInterval, Interval mod Self.FInterval);
                ExitLoop := False;
                Break;
              end;
        until ExitLoop or (FInterval <= MinInterval);
        if FInterval < MinInterval then
          FInterval := MinInterval;
      end;
    end;
  end;
end;

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

procedure TJvTimerEvents.DeleteByHandle(AHandle: THandle);
var
  I: Integer;
begin
  I := ItemIndexByHandle(AHandle);
  if I >= 0 then
    Delete(I);
  if FParent.Active then
  begin
    CalculateInterval(GetTickCount);
    FParent.UpdateTimer;
  end;
end;

function TJvTimerEvents.GetEnabledCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
    if Items[I].Enabled then
      Inc(Result);
end;

function TJvTimerEvents.GetItem(Index: Integer): TJvTimerEvent;
begin
  Result := TJvTimerEvent(inherited Items[Index]);
end;

function TJvTimerEvents.ItemByHandle(AHandle: THandle): TJvTimerEvent;
var
  I: Integer;
begin
  I := ItemIndexByHandle(AHandle);
  if I >= 0 then
    Result := Items[I]
  else
    Result := nil;
end;

function TJvTimerEvents.ItemIndexByHandle(AHandle: THandle): Integer;
begin
  for Result := 0 to Count - 1 do
    if Items[Result].Handle = AHandle then
      Exit;
  Result := -1;
end;

function TJvTimerEvents.NextHandle: THandle;
begin
  Inc(FSequence);
  Result := FSequence;
end;

procedure TJvTimerEvents.Notify(Item: TCollectionItem;
  Action: TCollectionNotification);
begin 
  inherited Notify(Item, Action); 
  if Action = cnAdded then
    with TJvTimerEvent(Item) do
    begin
      FParentList := FParent;
      FHandle := NextHandle;
      FParentList := Self.FParent;
      CalculateInterval(GetTickCount);
      if FParent.Sorted then
        Sort;
      FParent.UpdateTimer;
    end;
end;

function TJvTimerEvents.ProcessEvents: Boolean;
var
  I: Integer;
  Item: TJvTimerEvent;
  StartTicks: Longint;
begin
  Result := False;
  if not (csDesigning in (Owner as TJvTimerList).ComponentState) then
  begin
    StartTicks := GetTickCount;
    for I := Count - 1 downto 0 do
    begin
      Item := Items[I];
      if (Item <> nil) and Item.Enabled then
        with Item do
          if (StartTicks - FLastExecute) >= (Interval - (MinInterval div 2)) then
          begin
            FLastExecute := StartTicks;
            Inc(FExecCount);
            Enabled := not ((not Cycled) and (FExecCount >= RepeatCount));
            if not Enabled then
              Result := True;
            FParent.DoTimer(Item);
          end;
    end;
  end;
end;

procedure TJvTimerEvents.SetItem(Index: Integer; const Value: TJvTimerEvent);
begin
  inherited Items[Index] := Value;
end;

procedure TJvTimerEvents.Sort;
var
  I: Integer;
  ExitLoop: Boolean;
begin
  if not (csDesigning in (Owner as TJvTimerList).ComponentState) then
    repeat
      ExitLoop := True;
      for I := 0 to Count - 2 do
      begin
        if Items[I].Interval > Items[I + 1].Interval then
        begin
          Items[I].Index := I + 1;
//          Items[I+1].Index := I;
          ExitLoop := False;
        end;
      end;
    until ExitLoop;
end;

procedure TJvTimerEvents.UpdateEvents(StartTicks: Integer);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Items[I].Enabled then
      Items[I].FLastExecute := StartTicks;
end;

function TJvTimerEvent.GetDisplayName: String;
begin
  Result := Name;
  if Result = '' then
    Result := inherited GetDisplayName;
end;

function TJvTimerEvents.IndexOfName(const AName: string): Integer;
begin
  for Result := 0 to Count - 1 do
    if AnsiSameText(AName, Items[Result].Name) then
      Exit;
  Result := -1;
end;

function TJvTimerEvents.ItemByName(const AName: string): TJvTimerEvent;
var
  I: Integer;
begin
  I := IndexOfName(AName);
  if I >= 0 then
    Result := Items[I]
  else
    Result := nil;
end;

procedure TJvTimerList.SetSorted(const Value: Boolean);
begin
  if FSorted <> Value then
  begin
    FSorted := Value;
    if FSorted then Events.Sort;
  end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQTimerList.pas,v $';
    Revision: '$Revision: 1.19 $';
    Date: '$Date: 2004/11/06 22:08:20 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.