transeff.pas

delphi2007界面效果控件源码

    constructor Create;
    destructor  Destroy; override;

    procedure AddRect(R: TRect);
    procedure RemoveRect(Index: Integer);
    procedure Clear;

    property Count: Integer read GetRectCount;
    property Rects[Index: Integer]: TRect read GetRect write SetRect; default;
  end;
  {$endif TE_NOHLP}

  TFlickerFreeTransition = class(TTransitionEffect)
  public
    {$ifndef TE_NOHLP}
    Fake: Boolean;
    {$endif TE_NOHLP}

    constructor Create(AOwner: TComponent = nil); override;
    procedure Assign(Source: TPersistent); override;

    class function Description: String; override;
  protected
    procedure ExecuteFrame(Data: TTETransitionData; CurrentFrame, Step,
      LastExecutedFrame: Longint); override;
    function GetInfo(Device: TTETransitionDevice): TTETransitionInfo; override;
    function  GetPixelFormat(Device: TTETransitionDevice): TPixelFormat; override;
    procedure Initialize(Data: TTETransitionData; var TotalFrames: Longint);
      override;
  end;

  function  TEGetDirectionDesc(Direction: TTEEffectDirection): String;
  procedure TERegisterTransition(TransitionEffectClass: TTransitionEffectClass);

var
  TEGlobalDisabled: Boolean;
  TERegisteredTransitions: TList;
  FlickerFreeTransition: TFlickerFreeTransition;
  {$ifndef TE_NOHLP}
  OldTransition,
  NewTransition: TTransitionEffect;
  {$endif TE_NOHLP}

implementation

{$ifndef NoVCL}
uses teVclScr;
{$endif NoVCL}

{ Common procedures and functions }

function TEGetDirectionDesc(Direction: TTEEffectDirection): String;
begin
  case Direction of
    tedNone     : Result := '';
    tedRight    : Result := 'Right';
    tedLeft     : Result := 'Left';
    tedDown     : Result := 'Down';
    tedUp       : Result := 'Up';
    tedDownRight: Result := 'Down and right';
    tedDownLeft : Result := 'Down and left';
    tedUpRight  : Result := 'Up and right';
    tedUpLeft   : Result := 'Up and left';
    tedIn       : Result := 'In';
    tedOut      : Result := 'Out';
    tedRandom   : Result := 'Random';
    else          Result := '';
  end;
end;

procedure TERegisterTransition(TransitionEffectClass: TTransitionEffectClass);
begin
  if TERegisteredTransitions = nil then
    TERegisteredTransitions := TList.Create;

  if TERegisteredTransitions.IndexOf(TransitionEffectClass) = -1 then
    TERegisteredTransitions.Add(TransitionEffectClass);

  {$ifdef D6UP}
  StartClassGroup(TControl);
  ActivateClassGroup(TControl);
  GroupDescendentsWith(TransitionEffectClass, Controls.TControl);
  {$endif D6UP}

  Classes.RegisterClass(TransitionEffectClass);
end;

{ TTEPass2OptionsType }

constructor TTEPass2OptionsType.Create;
begin
  FDistributedTime := False;
  FReversed        := False;
  FUseSolidColor   := True;
  FSolidColor      := clNone;
end;

procedure TTEPass2OptionsType.Assign(Source: TPersistent);
var
  aux: TTEPass2OptionsType;
begin
  if Source is TTEPass2OptionsType
  then
  begin
    aux := (Source as TTEPass2OptionsType);

    FDistributedTime := aux.DistributedTime;
    FReversed        := aux.Reversed;
    FUseSolidColor   := aux.UseSolidColor;
    FSolidColor      := aux.SolidColor;
  end
  else inherited;
end;

{ TTransitionEffect }
constructor TTransitionEffect.Create(AOwner: TComponent);
begin
  inherited;

  AllowedDirections        := [tedNone];
  FDirection               := tedNone;
  FAbortOnClick            := False;
  FAbortOnEscape           := False;
  FEnabled                 := True;
  FFlickerFreeWhenDisabled := False;
  ForceRendering           := False;
  NeverRendering           := False;
  FTransitionList          := nil;
  FPassSetting             := teOnePass;
  FReversed                := False;
  FPass2Options            := TTEPass2OptionsType.Create;
  FMinAbortInterval        := 300;
  FDelegatedFrom           := nil;

  {$ifndef NoDefTrDev}
  DefaultDevice      := nil;
  FClientCoordinates := True;
  {$endif NoDefTrDev}
end;

destructor TTransitionEffect.Destroy;
begin
  if Assigned(FTransitionList) then
    FTransitionList.RemoveTransition(Self);

  {$ifndef NoDefTrDev}
  UnPrepare;
  ReleaseDefaultDevice;
  {$endif NoDefTrDev}

  FPass2Options.Free;

  inherited;
end;

class function TTransitionEffect.Description: String;
begin
  Result := ClassName;
end;

procedure TTransitionEffect.Assign(Source: TPersistent);
var
  Transition: TTransitionEffect;
begin
  if Source is TTransitionEffect
  then
  begin
    Transition              := TTransitionEffect(Source);
    Milliseconds            := Transition.Milliseconds;
    MinAbortInterval        := Transition.MinAbortInterval;
    FPass2Options.Assign(Transition.Pass2Options);
    PassSetting             := Transition.PassSetting;
    ForceRendering          := Transition.ForceRendering;
    NeverRendering          := Transition.NeverRendering;
    Enabled                 := Transition.Enabled;
    FlickerFreeWhenDisabled := Transition.FlickerFreeWhenDisabled;
    if Transition.Direction in AllowedDirections then
      Direction             := Transition.Direction;
    Reversed                := Transition.Reversed;
    AbortOnClick            := Transition.AbortOnClick;
    AbortOnEscape           := Transition.AbortOnEscape;
    {$ifndef NoDefTrDev}
    ClientCoordinates       := Transition.ClientCoordinates;
    {$endif NoDefTrDev}
    {$ifdef LogTiming}
    Log                     := Transition.Log;
    {$endif LogTiming}
  end
  else inherited;
end;

function TTransitionEffect.HasParent: Boolean;
begin
  if FTransitionList <> nil
  then Result := True
  else Result := inherited HasParent;
end;

function TTransitionEffect.GetParentComponent: TComponent;
begin
  if FTransitionList <> nil
  then Result := FTransitionList
  else Result := inherited GetParentComponent;
end;

class function TTransitionEffect.GetEditor: String;
begin
  Result := 'TTransitionEffectEditor';
end;

procedure TTransitionEffect.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TTransitionList then
    TransitionList := TTransitionList(Reader.Parent);
end;

procedure TTransitionEffect.SetParentComponent(AParent: TComponent);
begin
  if(not(csLoading in ComponentState)) and (AParent is TTransitionList) then
    FTransitionList := TTransitionList(AParent);
end;

procedure TTransitionEffect.SetName(const Value: TComponentName);
begin
  inherited;

  if Assigned(FTransitionList) and Assigned(FTransitionList.Editor) then
    FTransitionList.Editor.Perform(CM_TENAMECHANGED, Longint(Self), 0);
end;

function TTransitionEffect.DirectionToUse: TTEEffectDirection;
begin
  if Reversed
  then Result := ReversedDirection
  else Result := Direction;
end;

function TTransitionEffect.ReversedDirection: TTEEffectDirection;
begin
  case Direction of
    tedRight    : Result := tedLeft;
    tedLeft     : Result := tedRight;
    tedDown     : Result := tedUp;
    tedUp       : Result := tedDown;
    tedDownRight: Result := tedUpLeft;
    tedDownLeft : Result := tedUpRight;
    tedUpRight  : Result := tedDownLeft;
    tedUpLeft   : Result := tedDownRight;
    tedIn       : Result := tedOut;
    tedOut      : Result := tedIn;
    else          Result := Direction;
  end;
end;

function TTransitionEffect.GetPixelFormat(
  Device: TTETransitionDevice): TPixelFormat;
begin
  Result := Device.PixelFormat;
end;

function TTransitionEffect.GetBitmapsWidth(Data: TTETransitionData): Integer;
begin
  Result := Data.Width;
end;

procedure TTransitionEffect.SetDirection(Value: TTEEffectDirection);
begin
  if Value in AllowedDirections then
    FDirection := Value;
end;

function TTransitionEffect.GetIndex: Integer;
begin
  if FTransitionList <> nil
  then Result := FTransitionList.FTransitions.IndexOf(Self)
  else Result := -1;
end;

procedure TTransitionEffect.SetIndex(Value: Integer);
var
  CurIndex,
  Count: Integer;
begin
  CurIndex := GetIndex;
  if CurIndex >= 0 then
  begin
    Count := FTransitionList.FTransitions.Count;
    if Value < 0 then
      Value := 0;
    if Value >= Count then
      Value := Count - 1;
    if Value <> CurIndex then
    begin
      FTransitionList.FTransitions.Delete(CurIndex);
      FTransitionList.FTransitions.Insert(Value, Self);
    end;
  end;
end;

procedure TTransitionEffect.SetEnabled(const Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    {$ifndef NoDefTrDev}
    if not FEnabled then
      UnPrepare;
    {$endif NoDefTrDev}
  end;
end;

procedure TTransitionEffect.SetTransitionList(const Value: TTransitionList);
begin
  if Value <> FTransitionList then
  begin
    if FTransitionList <> nil then
      FTransitionList.RemoveTransition(Self);
    if Value <> nil then
      Value.AddTransition(Self);
  end;
end;

function TTransitionEffect.GetVersion: String;
begin
  Result := BilleniumEffectsVersion;
end;

procedure TTransitionEffect.SetVersion(const Value: String);
begin
end;

function TTransitionEffect.Passes(Device: TTETransitionDevice): Integer;
{$ifndef NoDefTrDev}
var
  SaveDev: TTETransitionDevice;
{$endif NoDefTrDev}
begin
  {$ifndef NoDefTrDev}
  SaveDev := DefaultDevice;
  try
    if Device = nil then
    begin
      CheckDefaultDevice;
      Device := DefaultDevice;
    end;
  {$endif NoDefTrDev}

    Result := 0;
    if Device.TwoPassesCapable and (tetiTwoPassesCapable in GetInfo(Device))
    then
    begin
      case PassSetting of
        teOnePass:   Result := 1;
        teTwoPasses: Result := 2;
        tePaletteDependent:
          if Device.HasPalette
          then Result := 2
          else Result := 1;
      end;
    end
    else Result := 1;

  {$ifndef NoDefTrDev}
  finally
    if SaveDev = nil then
      ReleaseDefaultDevice;
  end;
  {$endif NoDefTrDev}
end;

{$ifndef NoDefTrDev}
procedure TTransitionEffect.CheckDefaultDevice;
begin
  if DefaultDevice = nil then
  begin
    DefaultDevice := TTEVCLScreenTrDevice.Create;
    try
      DefaultDevice.Transition := Self;
      TTEVCLScreenTrDevice(DefaultDevice).ClientCoordinates := ClientCoordinates;
    except
      on Exception do
      begin
        ReleaseDefaultDevice;
        raise;
      end;
    end;
  end;
end;

procedure TTransitionEffect.ReleaseDefaultDevice;
begin
  if DefaultDevice <> nil then
  begin
    DefaultDevice.Free;
    DefaultDevice := nil;
  end;
end;

function TTransitionEffect.GetAborted: Boolean;
begin
  if DefaultDevice <> nil
  then Result := DefaultDevice.Aborted
  else Result := False;
end;

function TTransitionEffect.GetExecuting: Boolean;
begin
  if DefaultDevice <> nil
  then Result := DefaultDevice.Executing
  else Result := False;
end;

function TTransitionEffect.GetPrepared: Boolean;
begin
  if DefaultDevice <> nil
  then Result := TTEVCLScreenTrDevice(DefaultDevice).Prepared
  else Result := False;
end;

procedure TTransitionEffect.Defrost;
begin
  if Assigned(DefaultDevice) then
    TTEVCLScreenTrDevice(DefaultDevice).Defrost;
end;

function TTransitionEffect.Freeze(Ctrl: TControl; R: TRect): Boolean;
begin
  CheckDefaultDevice;
  Result := TTEVCLScreenTrDevice(DefaultDevice).Freeze(Ctrl, R);
end;

function TTransitionEffect.Prepare(Ctrl: TControl; R: TRect): Boolean;
begin
  CheckDefaultDevice;
  Result := TTEVCLScreenTrDevice(DefaultDevice).Prepare(Ctrl, R);
end;