treeanimate.pas

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

{**********************************************}
{   TTreeAnimate Component                     }
{   Copyright (c) 2001-2002 by David Berneda   }
{**********************************************}
{$I TeeDefs.inc}
unit TreeAnimate;

interface

uses
  {$IFNDEF LINUX}
  Windows,
  {$ENDIF}
  {$IFDEF CLX}
  QExtCtrls, QGraphics,
  {$ELSE}
  ExtCtrls, Graphics,
  {$ENDIF}
  {$IFDEF CLR}
  System.ComponentModel,
  {$ENDIF}
  Classes, SysUtils, TeeProcs, TeeTree;

type
  TAnimationState=(asStopped, asPlaying, asPaused);

  TTreeAnimate=class; { forward }

  {$IFDEF CLR}
  [ToolBoxItem(False)]
  {$ENDIF}
  TAnimation=class(TComponent)
  private
    FDuration   : Integer;
    FEnabled    : Boolean;
    FLoop       : Boolean;
    FOnFrame    : TNotifyEvent;
    FStartFrame : Integer;

    ICurrentFrame : Integer;
  protected
    IAnimate    : TTreeAnimate;
    IPlaying    : TAnimationState;

    Procedure EndAnimation; virtual;
    Procedure NewNode; dynamic;
    Procedure NextFrame; virtual;
    Procedure StoreValue; virtual;

    Function GetOwner:TPersistent; override;
    procedure ReadState(Reader: TReader); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    class Function Description:String; virtual;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    Function Index:Integer;
    Function IsEnabled:Boolean; dynamic;

    property Animate:TTreeAnimate read IAnimate;
    procedure Continue; virtual;
    Function EndFrame:Integer;
    Procedure Pause; virtual;
    Procedure Play; virtual;
    Procedure Preview; dynamic;
    Procedure Stop; virtual;
  published
    property Duration:Integer read FDuration write FDuration default 10;
    property Enabled:Boolean read FEnabled write FEnabled default True;
    property Loop:Boolean read FLoop write FLoop default False;
    property StartFrame:Integer read FStartFrame write FStartFrame;

    property OnFrame:TNotifyEvent read FOnFrame write FOnFrame;
  end;

  TAnimationClass=class of TAnimation;

  TAnimations=class(TList)
  private
    IAnimate : TTreeAnimate;
    Function Get(Index:Integer):TAnimation;
    Procedure Put(Index:Integer; Const Value:TAnimation);
  public
    Destructor Destroy; override;

    Procedure Add(Animation:TAnimation);
    Procedure Clear; override;

    property Animate:TTreeAnimate read IAnimate;
    property Animation[Index:Integer]:TAnimation read Get write Put; default;
  end;

  TTreeAnimateEvents=packed record
    Continue : TNotifyEvent;
    Frame    : TNotifyEvent;
    Stop     : TNotifyEvent;
    Pause    : TNotifyEvent;
    Play     : TNotifyEvent;
  end;

  TTreeAnimate = class(TCustomTreeLink)
  private
    FAnimations : TAnimations;
    FLoop       : Boolean;
    FSpeed      : Integer;
    FState      : TAnimationState;

    FOnClear    : TNotifyEvent;
    FOnContinue : TNotifyEvent;
    FOnDeleted  : TNotifyEvent;
    FOnFrame    : TNotifyEvent;
    FOnPause    : TNotifyEvent;
    FOnPlay     : TNotifyEvent;
    FOnStop     : TNotifyEvent;

    IEndFrame   : Integer;
    ITimer      : TTimer;

    { Private declarations }
    function GetEndFrame: Integer;
    procedure InternalStop;
    procedure SetSpeed(const Value: Integer);
    Procedure SetTimerInterval;
    Procedure OnTimer(Sender: TObject);
  protected
    { Protected declarations }
    Procedure GetChildren(Proc:TGetChildProc; Root:TComponent); override;
    function GetChildOwner: TComponent; override;
    property OnDeleteShapes:TNotifyEvent read FOnDeleted write FOnDeleted;

  {$IFDEF CLR}
  public
  {$ENDIF}
    Procedure RestoreEvents(Const AnimateEvents:TTreeAnimateEvents);
    Procedure SaveEvents(Var AnimateEvents:TTreeAnimateEvents);
  public
    { Public declarations }
    CurrentFrame: Integer;

    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Continue;
    Procedure NextFrame;
    Procedure Pause;
    Procedure Play;
    Procedure Stop;

    property EndFrame:Integer read GetEndFrame;
  published
    { Published declarations }
    property Animations:TAnimations read FAnimations;
    property Loop:Boolean read FLoop write FLoop default False;
    property Speed:Integer read FSpeed write SetSpeed default 50;
    property State:TAnimationState read FState;

    property OnClear:TNotifyEvent read FOnClear write FOnClear;
    property OnContinue:TNotifyEvent read FOnContinue write FOnContinue;
    property OnFrame:TNotifyEvent read FOnFrame write FOnFrame;
    property OnPause:TNotifyEvent read FOnPause write FOnPause;
    property OnPlay:TNotifyEvent read FOnPlay write FOnPlay;
    property OnStop:TNotifyEvent read FOnStop write FOnStop;
  end;

  TNodeAnimation=class(TAnimation)
  private
    FNode : TTreeNodeShape;
    procedure SetNode(const ANode:TTreeNodeShape);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    Function IsEnabled:Boolean; override;
    Procedure Preview; override;

    property Node:TTreeNodeShape read FNode write SetNode;
  end;

  TIntegerAnimation=class(TNodeAnimation)
  private
    FEndValue   : Integer;
    FStartValue : Integer;

    OldValue    : Integer;
    Procedure SetEndValue(const Value:Integer);
  protected
    Procedure EndAnimation; override;
    Function GetValue:Integer; virtual; abstract;
    Procedure NewNode; override;
    Procedure NextFrame; override;
    Procedure SetValue(AValue:Integer); virtual; abstract;
    Procedure StoreValue; override;
  public
    Procedure Play; override;
    property Value:Integer read GetValue write SetValue;
  published
    property EndValue:Integer read FEndValue write SetEndValue default 0;
    property Node;
    property StartValue:Integer read FStartValue write FStartValue default 0;
  end;

  TFontSizeAnimation=class(TIntegerAnimation)
  protected
    Function GetValue:Integer; override;
    Procedure SetValue(AValue:Integer); override;
  public
    Procedure Preview; override;
  end;

  TMoveSizeDirection=(mdHorizontal, mdVertical);

  TMovementAnimation=class(TIntegerAnimation)
  private
    FDirection : TMoveSizeDirection;
  protected
    Function GetValue:Integer; override;
    Procedure SetValue(AValue:Integer); override;
  public
    Procedure Preview; override;
  published
    property Direction:TMoveSizeDirection read FDirection write FDirection;
  end;

  TTransparencyAnimation=class(TIntegerAnimation)
  protected
    Function GetValue:Integer; override;
    Procedure SetValue(AValue:Integer); override;
  public
    Procedure Preview; override;
  end;

  TTextTranspAnimation=class(TIntegerAnimation)
  protected
    Function GetValue:Integer; override;
    Procedure SetValue(AValue:Integer); override;
  public
    Procedure Preview; override;
  end;

  TSizeAnimation=class(TIntegerAnimation)
  private
    FDirection : TMoveSizeDirection;
  protected
    Function GetValue:Integer; override;
    Procedure SetValue(AValue:Integer); override;
  published
    property Direction:TMoveSizeDirection read FDirection write FDirection;
  end;

  TBooleanAnimation=class(TNodeAnimation)
  private
    FNewValue : Boolean;
    OldValue  : Boolean;
  protected
    Procedure EndAnimation; override;
    Function GetValue:Boolean; virtual; abstract;
    Procedure NewNode; override;
    Procedure NextFrame; override;
    Procedure SetValue(AValue:Boolean); virtual; abstract;
    Procedure StoreValue; override;
  public
    property Value:Boolean read GetValue write SetValue;
  published
    property NewValue:Boolean read FNewValue write FNewValue;
    property Node;
  end;

  TVisibleAnimation=class(TBooleanAnimation)
  protected
    Function GetValue:Boolean; override;
    Procedure SetValue(AValue:Boolean); override;
  public
    Procedure Stop; override;
  end;

  TColorAnimation=class(TNodeAnimation)
  private
    FEndColor   : TColor;
    FStartColor : TColor;

    OldColor    : TColor;
  protected
    Procedure EndAnimation; override;
    Function GetColor:TColor; virtual; abstract;
    Procedure NewNode; override;
    Procedure NextFrame; override;
    Procedure SetColor(AColor:TColor); virtual; abstract;
    Procedure StoreValue; override;
  public
    Constructor Create(AOwner: TComponent); override;

    Procedure Play; override;
    property Value:TColor read GetColor write SetColor;
  published
    property EndColor:TColor read FEndColor write FEndColor default clNone;
    property StartColor:TColor read FStartColor write FStartColor default clNone;
  end;

  TNodeColor=(ncColor,ncBorder,ncFont,ncGradientStart,ncGradientEnd,ncGradientMiddle);

  TNodeColorAnimation=class(TColorAnimation)
  private
    FColor : TNodeColor;
  protected
    Function GetColor:TColor; override;
    Procedure SetColor(AColor:TColor); override;
  public
    Procedure Preview; override;
  published
    property Node;
    property NodeColor:TNodeColor read FColor write FColor default ncColor;
  end;

  TTreeColor=(tcColor,tcGrid,tcGradientStart,tcGradientEnd,tcGradientMiddle);

  TTreeColorAnimation=class(TColorAnimation)
  private
    FColor : TTreeColor;
  protected
    Function GetColor:TColor; override;
    Procedure SetColor(AColor:TColor); override;
  public
    Function IsEnabled:Boolean; override;
    Procedure Preview; override;
  published
    property TreeColor:TTreeColor read FColor write FColor;
  end;

  TCustomAnimation=class(TAnimation);

  TAddTextAnimation=class(TNodeAnimation)
  private
    OldText : String;
  protected
    Procedure EndAnimation; override;
    Procedure NextFrame; override;
    Procedure StoreValue; override;
  public
    Procedure Play; override;
    Procedure Preview; override;
  published
    property Node;
  end;

  TMoveTextAnimation=class(TNodeAnimation)
  private
    OldOffset : Integer;
  protected
    Procedure EndAnimation; override;
    Procedure NextFrame; override;
    Procedure StoreValue; override;
  public
    Procedure Play; override;
  published
    property Node;
  end;

  TTextAngleAnimation=class(TIntegerAnimation)
  protected
    Function GetValue:Integer; override;
    Procedure SetValue(AValue:Integer); override;
  public
    Procedure Preview; override;
  end;

  TTextFlashAnimation=class(TNodeAnimation)
  private
    OldSize      : Integer;
    StartSize    : Integer;
    FSizePercent : Integer;
  protected
    Procedure EndAnimation; override;
    Procedure NextFrame; override;
    Procedure StoreValue; override;
  public
    Constructor Create(AOwner: TComponent); override;
    Procedure Play; override;
  published
    property Node;
    property SizePercent:Integer read FSizePercent write FSizePercent default 100;
  end;

  TTextColorAnimation=class(TColorAnimation)
  protected
    Function GetColor:TColor; override;
    Procedure SetColor(AColor:TColor); override;
  public
    Procedure Preview; override;
  published
    property Node;
  end;

  TNodeZoomAnimation=class(TNodeAnimation)
  private
    FZoomPercent : Integer;
    OldBounds    : TRect;
    Procedure SetNodeBounds(Const R:TRect);
  protected
    Procedure EndAnimation; override;
    Procedure NextFrame; override;
    Procedure StoreValue; override;
  public
    Constructor Create(AOwner: TComponent); override;
    Procedure Preview; override;
  published
    property Node;
    property ZoomPercent:Integer read FZoomPercent write FZoomPercent default 100;
  end;

const //tom:13/09/2002
  MoveSizeDirection: Array[TMoveSizeDirection] of String =('Horizontal','Vertical');
  NodeColor: Array[TNodeColor] of String = ('Color', 'Border', 'Font',
                                            'GradientStart', 'GradientEnd',
                                            'GradientMiddle');
  TreeColor: Array[TTreeColor] of String = ('Color', 'Grid',
                                            'GradientStart', 'GradientEnd',
                                            'GradientMiddle');


Procedure RegisterAnimation(Animation:TAnimationClass);

var AnimationClasses : TList;

implementation

Uses TeCanvas;

{ TTreeAnimate }

Constructor TTreeAnimate.Create(AOwner: TComponent);
begin
  inherited;
  FAnimations:=TAnimations.Create;
  FAnimations.IAnimate:=Self;
  FSpeed:=50;
end;

Destructor TTreeAnimate.Destroy;
begin
  Stop;
  FAnimations.Free;
  inherited;
end;

// Returns the biggest frame number
// (The longest StartFrame + Duration of all Enabled actions)
function TTreeAnimate.GetEndFrame: Integer;
var t : Integer;
begin
  result:=0;
  for t:=0 to Animations.Count-1 do
  with Animations[t] do
       if EndFrame>result then result:=EndFrame;
end;

procedure TTreeAnimate.Pause;  // pause playing
var t: Integer;
begin
  if Assigned(ITimer) then ITimer.Enabled:=False;
  for t:=0 to Animations.Count-1 do Animations[t].Pause;
  FState:=asPaused;

  if Assigned(FOnPause) then FOnPause(Self);
end;

procedure TTreeAnimate.Continue; // resumes playing
var t: Integer;
begin
  for t:=0 to Animations.Count-1 do Animations[t].Continue;
  FState:=asPlaying;

  if Assigned(FOnContinue) then FOnContinue(Self);

  if Assigned(ITimer) then ITimer.Enabled:=True;
end;

procedure TTreeAnimate.Play;  // start playing
var t : Integer;