transeff.pas

delphi2007界面效果控件源码

unit TransEff;

interface

{$INCLUDE teDefs.inc}

uses
  Windows, Messages, SysUtils, Classes, Consts, Graphics, Controls, Forms,
  teChrono, teRender, SyncObjs;

{$ifndef TE_NOHLP}
const
  CM_TENAMECHANGED      = CM_BASE + 533;
  CM_TETHREADTERMINATED = CM_BASE + 534;
{$endif TE_NOHLP}

resourcestring
  rsTETransitionBusy     = 'Transition is busy';
  rsTEDevTrIsNil         = 'Device''s transition is not assigned';
  rsTETransNotThreadSafe = 'Transition is not thread safe';
  rsTEDevNotThreadSafe   = 'Device is not thread safe';

type
  TTEPassSettingType  = (teOnePass, teTwoPasses, tePaletteDependent);
  TTEEffectDirection  = (tedNone, tedRight, tedLeft, tedDown, tedUp,
    tedDownRight, tedDownLeft, tedUpRight, tedUpLeft, tedIn, tedOut, tedRandom);
  TTEEffectDirections = set of TTEEffectDirection;
  {$ifndef TE_NOHLP}
  TTETransitionInfo = set of (
    tetiMillisecondsCapable,   // Supports timing
    tetiNeedDstBmp,            // Needs the destination bitmap
    tetiNeedOffScreenBmp,      // Needs the offscreen bitmap
    tetiNeedSrcBmp,            // Needs the source bitmap
    tetiOffScreenBmpCapable,   // Supports using an offscreen bitmap
    tetiStaticSrcPixels,       // Pixels in the source bitmap never move while displayed
    tetiUseDirtyRects,         // Uses the list of dirty rects
    tetiUseSrcAsOffScreenBmp,  // Uses SrcBmp as offscreen bitmap
    tetiThreadSafe,            // Transition is thread-safe
    tetiTwoPassesCapable);     // Supports two passes
  {$endif TE_NOHLP}

  ETransitionEffectError = class(Exception);

  TTransitionEffect   = class;
  {$ifndef TE_NOHLP}
  TTETransitionDevice = class;
  {$endif TE_NOHLP}
  TTEAbortQueryEvent  = procedure(Sender: TObject; Transition: TTransitionEffect;
    var Abort: Boolean) of object;

  TTEPass2OptionsType = class(TPersistent)
  private
    FDistributedTime,
    FReversed,
    FUseSolidColor: Boolean;
    FSolidColor: TColor;
  public
    constructor Create; virtual;

    procedure Assign(Source: TPersistent); override;
  published
    property DistributedTime: Boolean read FDistributedTime write FDistributedTime default False;
    property Reversed: Boolean read FReversed write FReversed default False;
    property UseSolidColor: Boolean read FUseSolidColor write FUseSolidColor default True;
    property SolidColor: TColor read FSolidColor write FSolidColor default clNone;
  end;

  {$ifndef TE_NOHLP}
  TTETransitionData = class;
  TTEDirtyRects     = class;
  TTEMakeSubComponentLinkable = procedure(ComponentClass: TComponentClass) of object;
  {$endif TE_NOHLP}
  TTransitionList   = class;

  {$ifdef LogTiming}
  TTELogItem = record
    LogExTime: Single;
    LogFrame: Integer;
    LogInterval: Single;
    LogUpdateTime: Single;
    LogSleepTime: Single;
    LogSleepPrecision: Single;
    LogStep: Single;
    LogStepTime: Single;
    LogTransitionTime: Single;
    LogWorkTime: Single;
    LogText: string;
  end;
  PTELogItem = ^TTELogItem;

  TTELogBase = class(TComponent)
  public
    ItemCount: Integer;
    ChronoExtra: TTEChrono;
    Detailed: Boolean;
    function CurrentItem: PTELogItem; virtual; abstract;
    function LastTransitionTime: Single; virtual; abstract;
    procedure NewItem; virtual; abstract;
    procedure SaveLog(Transition: TTransitionEffect; Data: TTETransitionData;
      ElapsedTime: Double); virtual; abstract;
    procedure SetSize(Size: Integer); virtual; abstract;
  end;
  {$endif LogTiming}

  TTransitionEffect = class(TComponent)
  private
    FDirection: TTEEffectDirection;
    FReversed: Boolean;
    FTransitionList: TTransitionList;
    FAbortOnClick,
    FAbortOnEscape,
    FEnabled,
    FFlickerFreeWhenDisabled: Boolean;
    FMinAbortInterval,
    FMilliseconds: Longint;
    FPass2Options: TTEPass2OptionsType;
    FPassSetting: TTEPassSettingType;
    FDelegatedFrom: TTransitionEffect;

    FOnAbortQuery: TTEAbortQueryEvent;
    FOnAfterTransition,
    FOnBeforeTransition,
    FOnStartTransition,
    FOnEndTransition: TNotifyEvent;
    {$ifndef NoDefTrDev}
    FClientCoordinates: Boolean;
    {$endif NoDefTrDev}

    procedure SetDirection(Value: TTEEffectDirection);
    function  GetIndex: Integer;
    procedure SetIndex(Value: Integer);
    procedure SetEnabled(const Value: Boolean);
    procedure SetTransitionList(const Value: TTransitionList);
    function  GetVersion: String;
    procedure SetVersion(const Value: String);

    {$ifndef NoDefTrDev}
    procedure CheckDefaultDevice;
    procedure ReleaseDefaultDevice;
    function  GetAborted: Boolean;
    function  GetExecuting: Boolean;
    function  GetPrepared: Boolean;
    {$endif NoDefTrDev}
  protected
    {$ifndef NoDefTrDev}
    DefaultDevice: TTETransitionDevice;
    {$endif NoDefTrDev}

    procedure SetName(const Value: TComponentName); override;
    function  DirectionToUse: TTEEffectDirection;
    function  EditorQuestion: string; virtual;
    function  ReversedDirection: TTEEffectDirection; virtual;
    function  GetBitmapsWidth(Data: TTETransitionData): Integer; virtual;
    function  GetPixelFormat(Device: TTETransitionDevice): TPixelFormat; virtual;
    procedure ReadState(Reader: TReader); override;
    procedure Initialize(Data: TTETransitionData; var Frames: Longint); virtual;
    function  MakeSubComponentsLinkable(Proc: TTEMakeSubComponentLinkable): Boolean; virtual;
    procedure Finalize(Data: TTETransitionData); virtual;
    procedure ExecuteFrame(Data: TTETransitionData; CurrentFrame,
      Step, LastExecutedFrame: Longint); virtual; abstract;
    function  GetInfo(Device: TTETransitionDevice): TTETransitionInfo; virtual;
  public
    AllowedDirections: TTEEffectDirections;
    ForceRendering,
    NeverRendering: Boolean;
    {$ifdef LogTiming}
    Log: TTELogBase;
    {$endif LogTiming}

    constructor Create(AOwner: TComponent = nil); override;
    destructor  Destroy; override;

    class function Description: String; virtual;

    procedure Assign(Source: TPersistent); override;
    function  HasParent: Boolean; override;
    function  GetParentComponent: TComponent; override;
    class function GetEditor: String; virtual;
    procedure SetParentComponent(AParent: TComponent); override;
    function  Passes(Device: TTETransitionDevice): Integer;

    {$ifndef NoDefTrDev}
    {$ifndef TE_NOHLP}
    procedure Abort;
    function  GetDelegate(Device: TTETransitionDevice;
      const ReturnCopy: Boolean): TTransitionEffect; virtual;
    {$endif TE_NOHLP}
    procedure Defrost;
    procedure Execute;
    function  Freeze(Ctrl: TControl; R: TRect): Boolean;
    function  Frozen: Boolean;
    function  Prepare(Ctrl: TControl; R: TRect): Boolean;
    procedure Prepare2ndPass;
    procedure UnPrepare;

    property ClientCoordinates: Boolean read FClientCoordinates write FClientCoordinates;
    {$endif NoDefTrDev}

    property Direction: TTEEffectDirection read FDirection write SetDirection;
    property Milliseconds: Longint read FMilliseconds write FMilliseconds default 0;
    property MinAbortInterval: Longint read FMinAbortInterval write FMinAbortInterval default 300;
    property Reversed: Boolean read FReversed write FReversed default False;
    {$ifndef TE_NOHLP}
    property Index: Integer read GetIndex write SetIndex stored False;
    property TransitionList: TTransitionList read FTransitionlist write SetTransitionList;
    {$endif TE_NOHLP}
    {$ifndef NoDefTrDev}
    property Aborted: Boolean read GetAborted;
    property DelegatedFrom: TTransitionEffect read FDelegatedFrom;
    property Executing: Boolean read GetExecuting;
    property Prepared: Boolean read GetPrepared;
    {$endif NoDefTrDev}
    property Pass2Options: TTEPass2OptionsType read FPass2Options write FPass2Options;
    property PassSetting: TTEPassSettingType read FPassSetting write FPassSetting default teOnePass;
  published
    property AbortOnClick: Boolean read FAbortOnClick write FAbortOnClick default False;
    property AbortOnEscape: Boolean read FAbortOnEscape write FAbortOnEscape default False;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property FlickerFreeWhenDisabled: Boolean read FFlickerFreeWhenDisabled write FFlickerFreeWhenDisabled default False;
    property Version: String read GetVersion write SetVersion stored False;

    property OnAbortQuery: TTEAbortQueryEvent read FOnAbortQuery write FOnAbortQuery;
    property OnAfterTransition: TNotifyEvent read FOnAfterTransition write FOnAfterTransition;
    property OnBeforeTransition: TNotifyEvent read FOnBeforeTransition write FOnBeforeTransition;
    property OnEndTransition  : TNotifyEvent read FOnEndTransition   write FOnEndTransition;
    property OnStartTransition: TNotifyEvent read FOnStartTransition write FOnStartTransition;
  end;

  {$ifndef TE_NOHLP}
  TTETransitionThread = class(TThread)
  private
    Device: TTETransitionDevice;
    ExceptionRaised: Exception;

    procedure OnStart;
  protected
    procedure DoTerminate; override;
    procedure Execute; override;
  public
    CSSync: TRTLCriticalSection;
    WaitEvent: TSimpleEvent;
    NotifyTermination: Boolean;
    Executing,
    Executed: Boolean;

    constructor Create(ADevice: TTETransitionDevice);
    destructor  Destroy; override;
    procedure   DebugString(const Text: String);
  end;

  TTETransitionDevice = class(TObject)
  private
    FUsingThread: Boolean;
    FTransition: TTransitionEffect;

    procedure SetTransition(const Value: TTransitionEffect);
    procedure DoTimedExecution(Data: TTETransitionData;
      TransitionChrono: TTEChrono);
    procedure DoCompleteExecution(Data: TTETransitionData;
      TransitionChrono: TTEChrono);
  protected
    FAborted,
    FExecuting,
    FreeDelegateTransition,
    RenderSrcFrame,
    RenderDstFrame: Boolean;
    FTransitionThread: TTETransitionThread;
    SrcImage,
    Pass2Image,
    DstImage: TBitmap;
    Data: TTETransitionData;
    CSThread,
    CSBitmap: TRTLCriticalSection;
    PostponedOnEnd: Boolean;

    function  AllowTransition: Boolean; virtual;
    function  CheckAbort(CheckTimer: Boolean): Boolean; virtual;
    procedure ExePass(Pass: Integer; Pass2Chrono: TTEChrono; TotalMilliseconds:
      Integer);
    procedure Finalize; virtual;
    procedure Initialize; virtual;
    procedure TransitionInitialized; virtual;
    procedure CustomExecute; virtual; abstract;
    procedure GetOffScreenBmp(var OldPalette: hPalette); virtual;
    procedure Get2ndPassBmp;
    function  GetDelegateTransition(Original: TTransitionEffect;
      const ReturnCopy: Boolean): TTransitionEffect; virtual;
    function  GetExtTimingData(FrameRendered: Boolean): Integer; virtual;
    function  GetRenderWndHandle: HWnd; virtual;
    function  NeedOffScreenBmp: Boolean; virtual;
    procedure NextFrame(Data: TTETransitionData; InternalLoop: Boolean;
      CurrentFrame, Milliseconds, ElapsedTime: Longint; Chrono:
      TTEChrono; var Interval, LastWorkTime, StepStartTime, Step, SleepPrec1,
      SleepPrec2: Single);
    procedure OnTransitionThreadTerminated; virtual;
    function  TransitionToUse: TTransitionEffect;
    function  TransitionThread: TTETransitionThread;
    procedure UpdateDevice(TransitionChrono: TTEChrono);
    class function IsThreadSafe: Boolean; virtual;
    class function TransitionIsDisabled(Transition: TTransitionEffect;
      NoFlickerFreeWhenDisabled: Boolean): Boolean; virtual;
  public
    AllowAbort: Boolean;
    DelegateTransition: TTransitionEffect;

    constructor Create; virtual;
    destructor  Destroy; override;

    procedure Abort; virtual;
    function  AvoidScrolling: Boolean; virtual;
    function  Clipped: Boolean; virtual;
    function  DynamicClipping: Boolean; virtual;
    procedure Execute(WaitForCompletion: Boolean = True); virtual;
    function  GetCurrentFrameBmp(var CriticalSectionEntered: Boolean): TBitmap;
    function  HasPalette: Boolean; virtual; abstract;
    function  IsRGB: Boolean;
    function  PixelFormat: TPixelFormat; virtual; abstract;
    function  TwoPassesCapable: Boolean; virtual; abstract;
    property  Aborted: Boolean read FAborted;
    property  Executing: Boolean read FExecuting;
    property  Transition: TTransitionEffect read FTransition write SetTransition;
    property  UsingThread: Boolean read FUsingThread;
  end;

  TTransitionEffectClass = class of TTransitionEffect;
  PTransitionEffect = ^TTransitionEffect;

  TCMTENameChanged = packed record
    Msg: Cardinal;
    Transition: TTransitionEffect;
    Unused,
    Result: Longint;
  end;
  {$endif TE_NOHLP}

  TTransitionList = class(TComponent)
  private
    function  GetTransition(Index: Integer): TTransitionEffect;
    procedure SetTransition(Index: Integer; const Value: TTransitionEffect);
    function  GetVersion: String;
    procedure SetVersion(const Value: String);
  protected
    FTransitions: TList;

    function  GetTransitionCount: Integer;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    {$ifndef TE_NOHLP}
    Editor: TWinControl;
    {$endif TE_NOHLP}

    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure AddTransition(Transition: TTransitionEffect);
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    procedure RemoveTransition(Transition: TTransitionEffect);
    function  GetTransitionIndex(Transition: TTransitionEffect): Integer;

    property TransitionCount: Integer read GetTransitionCount;
    property Transitions[Index: Integer]: TTransitionEffect read GetTransition write SetTransition; default;
  published
    property Version: String read GetVersion write SetVersion stored False;
  end;

  {$ifndef TE_NOHLP}
  TTECustomData = class(TObject)
  public
    Data: TTETransitionData;

    constructor Create(AData: TTETransitionData); virtual;
  end;

  TTETransitionData = class(TObject)
  private
    FExternalTiming: Boolean;
    FBitmap: TBitmap;
    FSrcBmp: TBitmap;
    function GetCanvas: TCanvas;
    procedure SetExternalTiming(const Value: Boolean);
    procedure SetBitmap(const Value: TBitmap);
    procedure SetSrcBmp(const Value: TBitmap);
  protected
    AbortChrono: TTEChrono;
    CurFrameBmp: TBitmap;         // Current frame bitmap
    LastUpdateTime: Double;
    SleepChrono: TTEChrono;
  public
    AllowDeviceUpdate: Boolean;   // Updating the device's canvas is allowed or not
    AlwaysShowLastFrame: Boolean; // Show last transition's frame in any case
    Custom: TTECustomData;        // Custom data placeholder for transitions
    Device: TTETransitionDevice;  // Device where the transition is rendered
    DeviceCanvas: TCanvas;        // Canvas of the device
    DeviceWnd: HWnd;              // Window handle of the device (in case it's a window)
    DirtyRects: TTEDirtyRects;    // List of dirty rects (rects which need updating)
    DstBmp: TBitmap;              // Bitmap containing the final frame
    FirstFrame: Integer;          // First frame to render (if -1 then calculate it)
    Frames: Integer;              // Count of transition frames for the pass
    PassFrames: Integer;          // Frames in pass (Frames + Src or Dst frames)
    TotalFrames: Integer;         // Total frames in transition (Frames + Src or Dst frames in all passes)
    TotalFrameIndex: Integer;     // Absolute frame index
    Height: Integer;              // Height in pixels of the frames
    DeviceCanvasOrgOff: TPoint;   // Origin offset to apply to DeviceCanvas
    Palette: HPalette;            // Palette to use
    Pass: Integer;                // The current pass number
    PassCount: Integer;           // The count of passes to execute
    PixelFormat: TPixelFormat;    // Exact pixel format of the frames
    PassRenderSrcFrame: Boolean;  // Render source frame in current pass
    PassRenderDstFrame: Boolean;  // Render destination frame in current pass
    UnUpdateRect: TRect;          // Rectangle which doesn't need to be updated
    UnUpdateRectBak: TRect;       // Value of UnUpdateRect in the previous step
    UpdateRect: TRect;            // Rectangle which needs to be updated
    UpdateRectBak: TRect;         // Value of UpdateRect in the previous step
    Width: Integer;               // Width in pixels of the frames

    constructor Create; virtual;
    destructor Destroy; override;
    property Bitmap: TBitmap read FBitmap write SetBitmap;       // Offscreen bitmap which holds the working frame
    property Canvas: TCanvas read GetCanvas;                     // Canvas of the current frame
    property ExternalTiming: Boolean read FExternalTiming write SetExternalTiming; // The timing is provided by the device
    property SrcBmp: TBitmap read FSrcBmp write SetSrcBmp;       // Bitmap containing the initial frame
  end;

  TTEDirtyRects = class(TObject)
  private
    FRects: TList;

    function  GetRect(Index: Integer): TRect;
    procedure SetRect(Index: Integer; const Value: TRect);
  protected
    procedure CheckOverlap(R: TRect);
    function  GetRectCount: Integer;
  public
    CheckBounds,
    AutoClear: Boolean;
    Bounds: TRect;