dxfading.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 644 行 · 第 1/2 页

{*******************************************************************}
{                                                                   }
{       Developer Express Visual Component Library                  }
{       Express Cross Platform Library classes                                      }
{                                                                   }
{       Copyright (c) 1998-2008 Developer Express Inc.              }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS   }
{   LICENSED TO DISTRIBUTE THE EXPRESSBARS AND ALL ACCOMPANYING VCL }
{   CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY.                 }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT  }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                      }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit dxFading;

{$I cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Types,
{$ENDIF}
  Windows, Classes, SysUtils, Graphics, cxGraphics, ExtCtrls, dxGDIPlusClasses,
  dxGDIPlusApi, cxControls, cxClasses;

const
  dxFadeInDefaultAnimationFrameCount: Integer = 4;
  dxFadeInDefaultAnimationFrameDelay: Integer  = 15;
  dxFadeOutDefaultAnimationFrameCount: Integer = 12;
  dxFadeOutDefaultAnimationFrameDelay: Integer  = 20;

type
  TdxFader = class;
  TdxFadingList = class;

  IdxFadingElementData = interface
  ['{982B842D-FF38-4E6E-B7CE-BB608FE193F7}']
    function DrawImage(DC: HDC; const R: TRect): Boolean;
    function GetFadeWorkImage(out AImage: TdxGPImage): Boolean;
  end;

  TdxFadingObjectState = (fosNone, fosGetParams, fosFading);

  IdxFadingObject = interface
  ['{73AB2A92-CDD9-4F13-965A-DC799DE837F9}']
    function CanFade: Boolean;
    procedure DrawFadeImage;
    procedure FadingBegin(AData: IdxFadingElementData);
    procedure FadingEnd;
    procedure GetFadingParams(
      out AFadeOutImage, AFadeInImage: TcxBitmap;
      var AFadeInAnimationFrameCount, AFadeInAnimationFrameDelay: Integer;
      var AFadeOutAnimationFrameCount, AFadeOutAnimationFrameDelay: Integer);
  end;

  { TdxFadingElement }

  TdxFadingState = (fsFadeIn, fsFadeOut);

  TdxFadingElement = class(TcxIUnknownObject, IdxFadingElementData)
  private
    FElement: TObject;
    FFadeInAnimationFrameCount: Integer;
    FFadeInAnimationFrameDelay: Integer;
    FFadeInImage: TdxGPImage;
    FFadeOutAnimationFrameCount: Integer;
    FFadeOutAnimationFrameDelay: Integer;
    FFadeOutImage: TdxGPImage;
    FFadingDelayCount: Integer;
    FFadingDelayIndex: Integer;
    FFadingObject: IdxFadingObject;
    FFadingWorkImage: TdxGPImage;
    FOwner: TdxFader;
    FStage: Integer;
    FState: TdxFadingState;
    function GetAnimationFrameCount: Integer;
    procedure SetFadingWorkImage(AImage: TdxGPImage);
    procedure SetState(const Value: TdxFadingState);
    procedure ValidateStageParams;
  protected
    procedure CalculateIntervals;
    procedure CheckBitmapColors(var AColors: TdxRGBColors);
    function CreateGPImage(const ABitmap: TcxBitmap): TdxGPImage;
    procedure DoFade;
    function GetFinalImageState: TdxGPImage;
    function GetInvertedStage: Integer;
    function GetStageAlpha: Byte;
    // IdxFadingElementData
    function DrawImage(DC: HDC; const R: TRect): Boolean;
    function GetFadeWorkImage(out AImage: TdxGPImage): Boolean;
    // Properties
    property AnimationFrameCount: Integer read GetAnimationFrameCount;
    property FadeInAnimationFrameCount: Integer read FFadeInAnimationFrameCount;
    property FadeInAnimationFrameDelay: Integer read FFadeInAnimationFrameDelay;
    property FadeOutAnimationFrameCount: Integer read FFadeOutAnimationFrameCount;
    property FadeOutAnimationFrameDelay: Integer read FFadeOutAnimationFrameDelay;
    property FadingDelayCount: Integer read FFadingDelayCount;
    property Owner: TdxFader read FOwner;
    property Stage: Integer read FStage;
  public
    constructor Create(AOwner: TdxFader; AElement: TObject;
      AState: TdxFadingState; const AFadeOutImage, AFadeInImage: TcxBitmap;
      AFadeInAnimationFrameCount, AFadeInAnimationFrameDelay: Integer;
      AFadeOutAnimationFrameCount, AFadeOutAnimationFrameDelay: Integer);
    destructor Destroy; override;
    procedure Initialize;
    procedure Finalize;
    // Properties
    property Element: TObject read FElement;
    property FadingWorkImage: TdxGPImage read FFadingWorkImage write SetFadingWorkImage;
    property State: TdxFadingState read FState write SetState;
  end;

  { TdxFadingObjectHelper }

  TdxFadingObjectHelper = class(TcxIUnknownObject, IdxFadingObject)
  private
    FFadingElementData: IdxFadingElementData;
    function GetIsEmpty: Boolean;
  protected
    // IdxFadingObject
    function CanFade: Boolean; virtual;
    procedure DrawFadeImage; virtual;
    procedure FadingBegin(AData: IdxFadingElementData);
    procedure FadingEnd;
    procedure GetFadingParams(out AFadeOutImage: TcxBitmap;
      out AFadeInImage: TcxBitmap; var AFadeInAnimationFrameCount: Integer;
      var AFadeInAnimationFrameDelay: Integer; var AFadeOutAnimationFrameCount: Integer;
      var AFadeOutAnimationFrameDelay: Integer); virtual;
  public
    procedure DrawImage(DC: HDC; const R: TRect);
    // Properties
    property IsEmpty: Boolean read GetIsEmpty;
  end;

  { TdxFadingList }

  TdxFadingList = class(TList)
  private
    function GetItems(Index: Integer): TdxFadingElement;
  public
    procedure Clear; override;
    property Items[Index: Integer]: TdxFadingElement read GetItems; default;
  end;

  { TdxFader }

  TdxFaderAnimationState = (fasDefault, fasEnabled, fasDisabled);

  TdxFader = class(TObject)
  private
    FList: TdxFadingList;
    FMaxAnimationCount: Integer;
    FState: TdxFaderAnimationState;
    FTimer: TTimer;
    function GetActive: Boolean;
    function GetIsReady: Boolean;
    function GetSystemAnimationState: Boolean;
    procedure SetMaxAnimationCount(Value: Integer);
    procedure ValidateQueue;
  protected
    procedure AddFadingElement(AObject: TObject; AState: TdxFadingState);
    procedure DoFade(AObject: TObject; AState: TdxFadingState);
    procedure DoTimer(Sender: TObject);
    procedure RemoveFadingElement(AElement: TdxFadingElement);
    property Active: Boolean read GetActive;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Contains(AObject: TObject): Boolean;
    procedure FadeIn(AObject: TObject);
    procedure FadeOut(AObject: TObject);
    function Find(AObject: TObject; out AFadingElement: TdxFadingElement): Boolean;
    procedure Remove(AObject: TObject; ADestroying: Boolean = True);
    property IsReady: Boolean read GetIsReady;
    property MaxAnimationCount: Integer read FMaxAnimationCount write SetMaxAnimationCount;
    property State: TdxFaderAnimationState read FState write FState;
  end;

function dxFader: TdxFader;

implementation

uses
  Math;

const
  dxMaxAnimationFrameCount = 32;
  dxMaxAnimationFrameDelay = 300;
  dxMaxAnimationCount = 20;
  dxMinFadingInterval = 10;

var
  Fader: TdxFader;

function dxFader: TdxFader;
begin
  Result := Fader; 
end;

{ TdxFadingElement }

constructor TdxFadingElement.Create(AOwner: TdxFader; AElement: TObject;
  AState: TdxFadingState; const AFadeOutImage, AFadeInImage: TcxBitmap;
  AFadeInAnimationFrameCount, AFadeInAnimationFrameDelay: Integer;
  AFadeOutAnimationFrameCount, AFadeOutAnimationFrameDelay: Integer);
begin
  inherited Create;
  FOwner := AOwner;
  FElement := AElement;
  FState := AState;
  FFadeInAnimationFrameCount := AFadeInAnimationFrameCount;
  FFadeInAnimationFrameDelay := AFadeInAnimationFrameDelay;
  FFadeOutAnimationFrameCount := AFadeOutAnimationFrameCount;
  FFadeOutAnimationFrameDelay := AFadeOutAnimationFrameDelay;
  Supports(AElement, IdxFadingObject, FFadingObject);
  FFadeInImage := CreateGPImage(AFadeInImage);
  FFadeOutImage := CreateGPImage(AFadeOutImage);
  ValidateStageParams;
  Initialize;
end;

destructor TdxFadingElement.Destroy;
begin
  FadingWorkImage := GetFinalImageState;
  Owner.RemoveFadingElement(Self);
  FFadingObject.FadingEnd;
  FreeAndNil(FFadeOutImage);
  FreeAndNil(FFadeInImage);
  FadingWorkImage := nil;
  FFadingObject := nil;
  inherited Destroy;
end;

function TdxFadingElement.CreateGPImage(const ABitmap: TcxBitmap): TdxGPImage;
var
  AColors: TdxRGBColors;
begin
  AColors := dxGPImageClass.GetBitmapBits(ABitmap);
  CheckBitmapColors(AColors);
  Result := dxGPImageClass.CreateFromPattern(ABitmap.Width, ABitmap.Height,
    AColors, ABitmap.PixelFormat = pf32bit);
end;

procedure TdxFadingElement.CheckBitmapColors(var AColors: TdxRGBColors);
var
  I: Integer;
begin
  for I := Low(AColors) to High(AColors) do
    with AColors[I] do
    begin
      if (rgbBlue + rgbGreen + rgbRed > 0) and (rgbReserved = 0) then
        rgbReserved := $FF;
    end;
end;


procedure TdxFadingElement.Initialize;
begin
  FFadingObject.FadingBegin(Self);
  if State = fsFadeIn then
    FadingWorkImage := FFadeOutImage.Clone
  else
    FadingWorkImage := FFadeInImage.Clone;
end;

procedure TdxFadingElement.Finalize;
begin
  Free;
end;

function TdxFadingElement.GetFinalImageState: TdxGPImage;
begin
  if State = fsFadeIn then
    Result := FFadeInImage.Clone
  else
    Result := FFadeOutImage.Clone;
end;

function TdxFadingElement.GetInvertedStage: Integer;
begin
  if State = fsFadeIn then
    Result := Round((1 - Stage / (FadeInAnimationFrameCount + 1)) * FadeOutAnimationFrameCount)
  else
    Result := Round((1 - Stage / (FadeOutAnimationFrameCount + 1)) * FadeInAnimationFrameCount);
end;

function TdxFadingElement.GetStageAlpha: Byte;
begin
  if State = fsFadeIn then
    Result := Min(255, Stage * (256 div FadeInAnimationFrameCount))
  else
    Result := Max(0, 255 - Stage * (256 div FadeOutAnimationFrameCount));
end;

procedure TdxFadingElement.CalculateIntervals;
var
  AInterval: Integer;
begin