transeff.pas

delphi2007界面效果控件源码

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

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

procedure TTransitionEffect.Execute;
var
  SaveDev: TTETransitionDevice;
begin
  SaveDev := DefaultDevice;
  try
    CheckDefaultDevice;
    DefaultDevice.Execute;
  finally
    if SaveDev = nil then
      ReleaseDefaultDevice;
  end;
end;

function TTransitionEffect.Frozen: Boolean;
begin
  if Assigned(DefaultDevice)
  then Result := TTEVCLScreenTrDevice(DefaultDevice).Frozen
  else Result := False;
end;

procedure TTransitionEffect.Abort;
begin
  if DefaultDevice <> nil then
    DefaultDevice.Abort;
end;

{$endif NoDefTrDev}

function TTransitionEffect.EditorQuestion: string;
begin
  Result := '';
end;

procedure TTransitionEffect.Finalize(Data: TTETransitionData);
begin
  FreeAndNil(Data.Custom);
end;

function TTransitionEffect.GetDelegate(
  Device: TTETransitionDevice; const ReturnCopy: Boolean): TTransitionEffect;
begin
  Result := Device.GetDelegateTransition(Self, ReturnCopy);
end;

function TTransitionEffect.MakeSubComponentsLinkable(Proc:
    TTEMakeSubComponentLinkable): Boolean;
begin
  Result := False;
end;

procedure TTransitionEffect.Initialize(Data: TTETransitionData;
  var Frames: Longint);
begin
end;

function TTransitionEffect.GetInfo(
  Device: TTETransitionDevice): TTETransitionInfo;
begin
  Result :=
    [
      tetiNeedDstBmp,
      tetiNeedSrcBmp,
      tetiTwoPassesCapable
    ];
end;

{ TTransitionList }

constructor TTransitionList.Create(AOwner: TComponent);
begin
  inherited;

  Editor       := nil;
  FTransitions := TList.Create;
end;

destructor TTransitionList.Destroy;
begin
  Clear;
  FTransitions.Free;

  inherited;
end;

procedure TTransitionList.AddTransition(Transition: TTransitionEffect);
begin
  FTransitions.Add(Transition);
  Transition.FTransitionList := Self;
end;

procedure TTransitionList.Assign(Source: TPersistent);
var
  i: Integer;
  Src: TTransitionList;
  TransitionClass: TTransitionEffectClass;
  NewTransition: TTransitionEffect;
begin
  if Source is TTransitionList
  then
  begin
    Src := TTransitionList(Source);
    Clear;
    for i := 0 to Src.TransitionCount - 1 do
    begin
      TransitionClass := TTransitionEffectClass(Src.Transitions[i].ClassType);
      NewTransition   := TransitionClass.Create(Self);
      NewTransition.Assign(Src.Transitions[i]);
      AddTransition(NewTransition);
    end;
  end
  else inherited;
end;

procedure TTransitionList.Clear;
begin
  if Assigned(FTransitions) then
    while FTransitions.Count > 0  do
      TTransitionEffect(FTransitions[0]).Free;
end;

procedure TTransitionList.RemoveTransition(Transition: TTransitionEffect);
begin
  if FTransitions.Remove(Transition) >= 0 then
    Transition.FTransitionList := nil;
end;

function TTransitionList.GetTransitionCount: Integer;
begin
  if FTransitions = nil
  then Result := 0
  else Result := FTransitions.Count;
end;

function TTransitionList.GetTransition(Index: Integer): TTransitionEffect;
begin
  Result := FTransitions[Index];
end;

procedure TTransitionList.SetTransition(Index: Integer;
  const Value: TTransitionEffect);
begin
  Transitions[Index].Free;
  AddTransition(Value);
  Value.Index := Index;
end;

procedure TTransitionList.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  
  if(Operation = opRemove)            and
    (AComponent is TTransitionEffect) then
    RemoveTransition(TTransitionEffect(AComponent));
end;

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

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

procedure TTransitionList.GetChildren(Proc: TGetChildProc;
  Root: TComponent);
var
  i: Integer;
begin
  for i := 0 to FTransitions.Count - 1 do
    Proc(Transitions[i]);
end;

function TTransitionList.GetTransitionIndex(Transition: TTransitionEffect): Integer;
begin
  Result := FTransitions.IndexOf(Transition);
end;

{ TTEDirtyRects }

procedure TTEDirtyRects.AddRect(R: TRect);
var
  P: PRect;
begin
  if CheckBounds then
  begin
    IntersectRect(R, R, Bounds);
    if IsRectEmpty(R) then
      exit;
  end;


  New(P);
  P^ := R;
  FRects.Add(P);
end;

procedure TTEDirtyRects.RemoveRect(Index: Integer);
begin
  Dispose(FRects[Index]);
  FRects.Delete(Index);
end;

constructor TTEDirtyRects.Create;
begin
  FRects := TList.Create;

  CheckBounds := False;
  AutoClear   := True;
end;

destructor TTEDirtyRects.Destroy;
begin
  Clear;
  FRects.Free;

  inherited;
end;

procedure TTEDirtyRects.Clear;
var
  i: Integer;
begin
  for i := 0 to Count-1 do
    Dispose(FRects[i]);

  FRects.Clear;
end;

function TTEDirtyRects.GetRect(Index: Integer): TRect;
begin
  Result := TRect(FRects[Index]^);
end;

function TTEDirtyRects.GetRectCount: Integer;
begin
  Result := FRects.Count;
end;

procedure TTEDirtyRects.SetRect(Index: Integer; const Value: TRect);
begin
  TRect(FRects[Index]^) := Value;
end;

constructor TTECustomData.Create(AData: TTETransitionData);
begin
  inherited Create;

  Data := AData;
end;

constructor TTETransitionData.Create;
begin
  AllowDeviceUpdate   := True;
  AlwaysShowLastFrame := True;
  FBitmap             := nil;
  Custom              := nil;
  CurFrameBmp         := nil;
  Device              := nil;
  DeviceCanvas        := nil;
  DeviceWnd           := 0;
  DirtyRects          := nil;
  DstBmp              := nil;
  Height              := -1;
  LastUpdateTime      := 0;
  DeviceCanvasOrgOff  := Point(0, 0);
  Palette             := 0;
  Pass                := 0;
  PassCount           := 0;
  FirstFrame          := -1;
  Frames              := 0;
  PassFrames          := 0;
  PassRenderSrcFrame  := False;
  PassRenderDstFrame  := False;
  TotalFrames         := 0;
  PixelFormat         := pfDevice;
  FExternalTiming     := True;
  SleepChrono         := nil;
  FSrcBmp             := nil;
  UnUpdateRect        := Rect(0, 0, 0, 0);
  UpdateRect          := Rect(0, 0, 0, 0);
  UnUpdateRectBak     := Rect(0, 0, 0, 0);
  UpdateRectBak       := Rect(0, 0, 0, 0);
  Width               := -1;
end;

destructor TTETransitionData.Destroy;
begin
  if FBitmap <> FSrcBmp then
  begin
    if Assigned(FBitmap) then
    begin
      FBitmap.Canvas.Unlock;
      FreeAndNil(FBitmap);
    end;
  end;
  DirtyRects .Free;
  SleepChrono.Free;
  Custom     .Free;
end;

procedure TTEDirtyRects.CheckOverlap(R: TRect);
var
  i: Integer;
  RAux: TRect;
begin
  for i := 0 to FRects.Count-1 do
  begin
    if IntersectRect(RAux, R, GetRect(i)) then
      raise Exception.Create(
        Format(
          'DirtyRect overlapping: (%d, %d, %d, %d) -> (%d, %d, %d, %d)', [
          R.Left,
          R.Top,
          R.Right,
          R.Bottom,
          GetRect(i).Left,
          GetRect(i).Top,
          GetRect(i).Right,
          GetRect(i).Bottom
          ]));
  end;
end;
{ TTETransitionData }

function TTETransitionData.GetCanvas: TCanvas;
begin
  if Bitmap <> nil
  then Result := Bitmap.Canvas
  else Result := DeviceCanvas;
end;

procedure TTETransitionData.SetBitmap(const Value: TBitmap);
begin
  FBitmap     := Value;
  CurFrameBmp := Value;
end;

procedure TTETransitionData.SetExternalTiming(const Value: Boolean);
begin
  if FExternalTiming <> Value then
  begin
    FExternalTiming := Value;
    if FExternalTiming
    then FreeAndNil(SleepChrono)
    else SleepChrono := TTEChrono.Create;
  end;
end;

procedure TTETransitionData.SetSrcBmp(const Value: TBitmap);
begin
  if CurFrameBmp = FSrcBmp then
    CurFrameBmp := Value;
  FSrcBmp := Value;
end;

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

  Fake := False;
end;

procedure TFlickerFreeTransition.Assign(Source: TPersistent);
var
  Transition: TFlickerFreeTransition;
begin
  if Source is TFlickerFreeTransition
  then
  begin
    inherited;

    Transition := TFlickerFreeTransition(Source);
    Fake       := Transition.Fake;
  end
  else inherited;
end;

class function TFlickerFreeTransition.Description: String;
begin
  Result := 'Flicker free cut';
end;

procedure TFlickerFreeTransition.ExecuteFrame(Data: TTETransitionData;
    CurrentFrame, Step, LastExecutedFrame: Longint);
begin
  // Nothing
end;

function TFlickerFreeTransition.GetInfo(Device: TTETransitionDevice):
  TTETransitionInfo;
begin
  Result := inherited GetInfo(Device) +
    [
      tetiThreadSafe
    ] -
    [
      tetiNeedSrcBmp,
      tetiStaticSrcPixels,
      tetiTwoPassesCapable
    ];
  if Fake then
    Exclude(Result, tetiNeedDstBmp);
end;

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

procedure TFlickerFreeTransition.Initialize(Data: TTETransitionData; var
  TotalFrames: Longint);
begin
  inherited;
  
  TotalFrames := 1;
end;

{ TTETransitionDevice }

procedure TTETransitionDevice.Abort;
begin
  FAborted := True;