timerlst.pas

rxlib2.75控件包

        StartTicks := GetTickCount;
        SetEvents(StartTicks);
        CalculateInterval(StartTicks);
        Sort;
        UpdateTimer;
      end
      else begin
        KillTimer(FWndHandle, 1);
        Classes.DeallocateHWnd(FWndHandle);
        FWndHandle := INVALID_HANDLE_VALUE;
        if Assigned(FOnFinish) then FOnFinish(Self);
      end;
      FStartInterval := 0;
    end;
    FActive := Value;
  end;
end;

{$IFDEF WIN32}
procedure TRxTimerList.GetChildren(Proc: TGetChildProc {$IFDEF RX_D3};
  Root: TComponent {$ENDIF});
var
  I: Integer;
begin
  inherited GetChildren(Proc {$IFDEF RX_D3}, Root {$ENDIF});
  for I := 0 to FEvents.Count - 1 do
    Proc(TRxTimerEvent(FEvents[I]));
end;
{$ELSE}
procedure TRxTimerList.WriteComponents(Writer: TWriter);
var
  I: Integer;
  Item: TRxTimerEvent;
begin
  inherited WriteComponents(Writer);
  for I := 0 to FEvents.Count - 1 do begin
    Item := TRxTimerEvent(FEvents[I]);
    if Item.Owner = Writer.Root then Writer.WriteComponent(Item);
  end;
end;
{$ENDIF WIN32}

procedure TRxTimerList.Sort;
var
  I: Integer;
  ExitLoop: Boolean;
begin
  if not (csDesigning in ComponentState) then
    repeat
      ExitLoop := True;
      for I := 0 to Count - 2 do begin
        if TRxTimerEvent(FEvents[I]).Interval > TRxTimerEvent(FEvents[I + 1]).Interval then
        begin
          FEvents.Exchange(I, I + 1);
          ExitLoop := False;
        end;
      end;
    until ExitLoop;
end;

function TRxTimerList.NextHandle: Longint;
begin
  Inc(FSequence);
  Result := FSequence;
end;

function TRxTimerList.CreateNewEvent: TRxTimerEvent;
begin
  Result := TRxTimerEvent.Create(Owner);
end;

function TRxTimerList.AddItem(Item: TRxTimerEvent): Longint;
begin
  if FEvents.Add(Item) >= 0 then begin
    Item.FHandle := NextHandle;
    Item.FParentList := Self;
    Result := Item.FHandle;
    CalculateInterval(GetTickCount);
    Sort;
    UpdateTimer;
  end
  else Result := HInvalidEvent; { invalid handle }
end;

{ Create a new timer event and returns a handle }
function TRxTimerList.Add(AOnTimer: TNotifyEvent; AInterval: Longint;
  ACycled: Boolean): Longint;
var
  T: TRxTimerEvent;
begin
  T := CreateNewEvent;
  if (FEvents.Add(T) >= 0) then begin
    with T do begin
      OnTimer := AOnTimer;
      FParentList := Self;
      FHandle := NextHandle;
      Interval := AInterval;
      Cycled := ACycled;
      Result := FHandle;
    end;
    CalculateInterval(GetTickCount);
    Sort;
    UpdateTimer;
  end
  else begin
    T.Free;
    Result := HInvalidEvent; { invalid handle }
  end;
end;

function TRxTimerList.ItemIndexByHandle(AHandle: Longint): Integer;
begin
  for Result := 0 to FEvents.Count - 1 do
    if TRxTimerEvent(FEvents[Result]).Handle = AHandle then Exit;
  Result := -1;
end;

function TRxTimerList.ItemByHandle(AHandle: Longint): TRxTimerEvent;
var
  I: Integer;
begin
  I := ItemIndexByHandle(AHandle);
  if I >= 0 then Result := TRxTimerEvent(FEvents[I])
  else Result := nil;
end;

procedure TRxTimerList.Delete(AHandle: Longint);
var
  I: Integer;
  Item: TRxTimerEvent;
begin
  I := ItemIndexByHandle(AHandle);
  if I >= 0 then begin
    Item := TRxTimerEvent(FEvents[I]);
    RemoveItem(Item);
    if not (csDestroying in Item.ComponentState) then Item.Free;
    if Active then begin
      CalculateInterval(GetTickCount);
      UpdateTimer;
    end;
  end;
end;

function TRxTimerList.GetCount: Integer;
begin
  Result := FEvents.Count;
end;

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

procedure TRxTimerList.RemoveItem(Item: TRxTimerEvent);
begin
  FEvents.Remove(Item);
  Item.FParentList := nil;
end;

procedure TRxTimerList.Clear;
var
  I: Integer;
  Item: TRxTimerEvent;
begin
  for I := FEvents.Count - 1 downto 0 do begin
    Item := TRxTimerEvent(FEvents[I]);
    RemoveItem(Item);
    if not (csDestroying in Item.ComponentState) then Item.Free;
  end;
end;

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

function TRxTimerList.ProcessEvents: Boolean;
var
  I: Integer;
  Item: TRxTimerEvent;
  StartTicks: Longint;
begin
  Result := False;
  if not (csDesigning in ComponentState) then begin
    StartTicks := GetTickCount;
    for I := Count - 1 downto 0 do begin
      Item := TRxTimerEvent(FEvents[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;
            DoTimer(Item);
          end;
    end;
  end;
end;

procedure TRxTimerList.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
            (FStartInterval = 0) and Active then 
          begin
            if ProcessEvents then begin
              if EnabledCount = 0 then Deactivate
              else begin
                CalculateInterval(GetTickCount);
                UpdateTimer;
              end;
            end;
          end else
            UpdateTimer;
        except
          Application.HandleException(Self);
        end
      else Result := DefWindowProc(FWndHandle, Msg, wParam, lParam);
  end;
end;

procedure TRxTimerList.CalculateInterval(StartTicks: Longint);
var
  I: Integer;
  ExitLoop: Boolean;
begin
  if not (csDesigning in ComponentState) then begin
    if Count = 0 then FInterval := 0
    else begin
      FStartInterval := 0;
      FInterval := MaxLongInt;
      for I := 0 to Count - 1 do
        with TRxTimerEvent(FEvents[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 TRxTimerEvent(FEvents[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 TRxTimerList.UpdateTimer;
var
  FTimerInterval: Cardinal;
begin
  if not (csDesigning in ComponentState) then begin
    if FInterval <= MaxTimerInterval then FTimerInterval := FInterval
    else
      if (FInterval - FStartInterval) <= MaxTimerInterval then begin
        FTimerInterval := Cardinal(FInterval - FStartInterval);
        FStartInterval := 0;
      end
      else begin
        FTimerInterval := MaxTimerInterval;
        FStartInterval := FStartInterval + MaxTimerInterval;
      end;
    if not (csDesigning in ComponentState) and (FWndHandle <> INVALID_HANDLE_VALUE) then
    begin
      KillTimer(FWndHandle, 1);
      if EnabledCount = 0 then Deactivate
      else if FInterval > 0 then
        if SetTimer(FWndHandle, 1, FTimerInterval, nil) = 0 then begin
          Deactivate;
          raise EOutOfResources.Create(ResStr(SNoTimers));
        end;
    end;
  end;
end;

end.