treeanimate.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

begin
  if FState<>asPlaying then
  begin
    CurrentFrame:=-1;

    if not Assigned(ITimer) then
    begin
      ITimer:=TTimer.Create(nil);
      ITimer.Enabled:=False;
      ITimer.OnTimer:=OnTimer;
    end;

    SetTimerInterval;

    if Animations.Count>0 then
    begin
      for t:=0 to Animations.Count-1 do
      with Animations[t] do
           if IsEnabled then StoreValue;

      IEndFrame:=GetEndFrame;

      FState:=asPlaying;

      if Assigned(FOnPlay) then FOnPlay(Self);

      ITimer.Enabled:=True;
    end;
  end;
end;

Procedure TTreeAnimate.SetTimerInterval; // set internal timer interval
begin
  ITimer.Interval:=10000 div (FSpeed*FSpeed); // speed
end;

Procedure TTreeAnimate.NextFrame;  // process one single frame
begin
  if FState<>asStopped then
  begin
    // process next frame
    OnTimer(ITimer);

    // just in case it was the last frame and the Loop = True, do pause
    if FState<>asPaused then Pause;
  end;
end;

// Every frame is processed here, when the Timer triggers
Procedure TTreeAnimate.OnTimer(Sender: TObject);
var t : Integer;
begin
  Inc(CurrentFrame);

  for t:=0 to Animations.Count-1 do
  with Animations[t] do
  if IsEnabled then
  begin
    ICurrentFrame:=CurrentFrame;

    if StartFrame=ICurrentFrame then Play
    else
    if (ICurrentFrame>StartFrame) and (ICurrentFrame<=(EndFrame+1)) then
    begin
      NextFrame;
      if ICurrentFrame>EndFrame then
      begin
        Stop;
        if Loop then Play;
      end;
    end;
  end;

  if Assigned(FOnFrame) then FOnFrame(Self);

  // Last Frame ?
  if CurrentFrame>IEndFrame then
  begin
    // Stop animation
    InternalStop;

    // if loop, re-start again
    if FLoop then Play;
  end;
end;

procedure TTreeAnimate.InternalStop;
var t : Integer;
begin
  FreeAndNil(ITimer);
  CurrentFrame:=-1;

  if FState<>asStopped then
     for t:=0 to Animations.Count-1 do
     with Animations[t] do
     if IsEnabled then
     begin
       Stop;
       EndAnimation;
     end;

  FState:=asStopped;

  if (not (csDestroying in ComponentState)) then
     if Assigned(FOnStop) then FOnStop(Self);
end;

procedure TTreeAnimate.Stop; // stop playing
begin
  InternalStop;
end;

// Change animation speed
procedure TTreeAnimate.SetSpeed(const Value: Integer);
begin
  if FSpeed<>Value then
  begin
    FSpeed:=Value;

    // if playing, change timer interval
    if Assigned(ITimer) then SetTimerInterval;
  end;
end;

function TTreeAnimate.GetChildOwner: TComponent;
begin
  result:=Owner;
end;

procedure TTreeAnimate.GetChildren(Proc: TGetChildProc; Root: TComponent);
var t : Integer;
begin
  inherited;
  for t:=0 to Animations.Count-1 do Proc(Animations[t]);
end;

procedure TTreeAnimate.SaveEvents(var AnimateEvents: TTreeAnimateEvents);
begin
  with AnimateEvents do
  begin
    Continue :=Self.FOnContinue;
    Frame    :=Self.FOnFrame;
    Stop     :=Self.FOnStop;
    Pause    :=Self.FOnPause;
    Play     :=Self.FOnPlay;
  end;
end;

procedure TTreeAnimate.RestoreEvents(
  const AnimateEvents: TTreeAnimateEvents);
begin
  with AnimateEvents do
  begin
    Self.FOnContinue :=Continue;
    Self.FOnFrame    :=Frame;
    Self.FOnStop     :=Stop;
    Self.FOnPause    :=Pause;
    Self.FOnPlay     :=Play;
  end;
end;

{ TAnimations }

procedure TAnimations.Add(Animation: TAnimation);
begin
  Animation.IAnimate:=IAnimate;
  inherited Add(Animation);
end;

procedure TAnimations.Clear;
begin
  inherited;
  if Assigned(Animate.OnClear) then
     if (not (csDestroying in Animate.ComponentState)) then
        Animate.OnClear(Animate);
end;

destructor TAnimations.Destroy;
begin
//  While Count>0 do Animation[0].Free;
  inherited;
end;

function TAnimations.Get(Index: Integer): TAnimation;
begin
  result:=TAnimation(Items[Index]);
end;

procedure TAnimations.Put(Index: Integer; const Value: TAnimation);
begin
  TAnimation(Items[Index]).Assign(Value);
end;

{ TAnimation }

Constructor TAnimation.Create(AOwner:TComponent);
begin
  inherited {$IFDEF CLR}Create(AOwner){$ENDIF};
  FDuration:=10;
  FEnabled:=True;
end;

// Execute next frame
procedure TAnimation.NextFrame;
begin
  if Assigned(FOnFrame) then FOnFrame(Self);
end;

procedure TAnimation.Pause; // pause individual action
begin
  if IPlaying=asPlaying then IPlaying:=asPaused;
end;

procedure TAnimation.Play; // initialize action
begin
  IPlaying:=asPlaying;
end;

procedure TAnimation.Stop; // stop individual action
begin
  IPlaying:=asStopped;
end;

procedure TAnimation.Continue; // resume playing individual action
begin
  if IPlaying=asPaused then IPlaying:=asPlaying;
end;

function TAnimation.GetOwner: TPersistent;
begin
  if csWriting in ComponentState then
     result:=Self
  else
     result:=inherited GetOwner;
end;

procedure TAnimation.ReadState(Reader: TReader);
begin
  inherited;
  if Reader.Parent is TTreeAnimate then
  begin
    IAnimate:=TTreeAnimate(Reader.Parent);
    IAnimate.Animations.Add(Self);
  end;
end;

function TAnimation.GetParentComponent: TComponent;
begin
  result:=IAnimate;
end;

function TAnimation.HasParent: Boolean;
begin
  result:=True;
end;

procedure TAnimation.StoreValue;
begin
end;

procedure TAnimation.NewNode;
begin
end;

function TAnimation.Index: Integer;
begin
  result:=IAnimate.Animations.IndexOf(Self);
end;

procedure TAnimation.EndAnimation;
begin
end;

class function TAnimation.Description: String;
var s : String;
    t : Integer;
begin
  result:=ClassName;
  if Length(result)>0 then
  begin
    if result[1]='T' then Delete(result,1,1);
    if UpperCase(Copy(result,Length(result)-8,9))='ANIMATION' then
       Delete(result,Length(result)-8,9);
    s:=result[1];
    for t:=2 to Length(result) do
    begin
      if UpCase(result[t])=result[t] then
         s:=s+' ';
      s:=s+result[t];
    end;
    result:=s;
  end;
end;

function TAnimation.IsEnabled: Boolean;
begin
  result:=FEnabled;
end;

Destructor TAnimation.Destroy;
begin
  if Assigned(IAnimate) then
     IAnimate.Animations.Remove(Self);
  inherited;
end;

function TAnimation.EndFrame: Integer;
begin
  result:=StartFrame+Duration-1;
end;

procedure TAnimation.Preview;
begin
  // nothing
end;

{ TNodeAnimation }

procedure TNodeAnimation.SetNode(const ANode: TTreeNodeShape);
begin
  if FNode<>ANode then
  begin
    {$IFDEF D5}
    if Assigned(FNode) then
       FNode.RemoveFreeNotification(Self);
    {$ENDIF}

    FNode:=ANode;

    if Assigned(FNode) then FNode.FreeNotification(Self);
  end;
end;

procedure TNodeAnimation.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if not (csDestroying in ComponentState) then 
  if Operation=opRemove then
  begin
    if Assigned(FNode) and (AComponent=FNode) then
    begin
      // Node has been destroyed. Set Action Node to nil.
      FNode:=nil;

      // Call event
      if Assigned(IAnimate.FOnDeleted) then IAnimate.FOnDeleted(AComponent);
    end;
  end;
end;

function TNodeAnimation.IsEnabled: Boolean;
begin
  result:=inherited IsEnabled and Assigned(FNode);
end;

procedure TNodeAnimation.Preview;
begin
  // Do not call abstract "inherited" here
  Node:=Animate.Tree[0];
end;

{ TFontSizeAnimation }

procedure TFontSizeAnimation.SetValue(AValue: Integer);
begin
  Node.Font.Size:=AValue;
end;

function TFontSizeAnimation.GetValue: Integer;
begin
  result:=Node.Font.Size;
end;

procedure TFontSizeAnimation.Preview;
begin
  inherited;
  FStartValue:=Node.Font.Size;
  FEndValue:=Node.Font.Size*2;
end;

{ TMovementAnimation }

procedure TMovementAnimation.SetValue(AValue: Integer);
begin
  Case FDirection of
    mdHorizontal : Node.Left:=AValue;
    mdVertical   : Node.Top:=AValue;
  end;
end;

function TMovementAnimation.GetValue: Integer;
begin
  if FDirection=mdHorizontal then result:=Node.Left
                             else result:=Node.Top;
end;

procedure TMovementAnimation.Preview;
begin
  inherited;
  Node.Tree.HorzScrollBar.Automatic:=False;

  with Node.Border do
  begin
    Visible:=True;
    Width:=2;
    EndStyle:=esFlat;
  end;

  FStartValue:=Node.Tree.Width;
  FEndValue:=-Node.Width-Node.Border.Width;

  Animate.Speed:=10;
end;

{ TIntegerAnimation }

procedure TIntegerAnimation.NextFrame;
var tmp : Integer;
begin
  tmp:=StartValue+Round((ICurrentFrame-StartFrame)*(EndValue-StartValue)/Duration);

  Value:=tmp;

  if EndValue>=StartValue then
  begin
    if tmp>=FEndValue then Stop;
  end
  else
    if tmp<=FEndValue then Stop;

  inherited;
end;

procedure TIntegerAnimation.Play;
begin
  if IPlaying=asStopped then Value:=FStartValue;
  inherited;
end;

procedure TIntegerAnimation.EndAnimation;
begin
  if not (csDestroying in ComponentState) then
     Value:=OldValue;
  inherited;
end;

Procedure TIntegerAnimation.NewNode;
begin
  if Assigned(IAnimate) and (not (csLoading in IAnimate.ComponentState)) then
  if Assigned(Node) then 
  begin
    if FStartValue=0 then FStartValue:=Value;
    if FEndValue=0 then FEndValue:=Value;
  end;
end;

procedure TIntegerAnimation.StoreValue;
begin
  inherited;
  OldValue:=Value;
end;

Procedure RegisterAnimation(Animation:TAnimationClass);
begin
  RegisterClass(Animation);
  AnimationClasses.Add(TObject(Animation));
end;

procedure TIntegerAnimation.SetEndValue(const Value: Integer);
begin
  FEndValue:=Value;
end;

{ TTransparencyAnimation }

procedure TTransparencyAnimation.SetValue(AValue: Integer);
begin
  Node.Transparency:=AValue;