Effets de transition avec Lazarus et BGRABitmap

function TGVTransition.ComputeInterpolation(AStart, AEnd: Single): Single;
// *** calcul d'une interpolation ***
var
  LDiff: Single;
  LSign, LStep: Integer;

  function Exponant(AExp: byte): Single; inline;
  begin
    Result := LDiff * Power(LStep, AExp) / Power(100, AExp);
  end;

  function DownExponant(AExp: byte): Single; inline;
  begin
    Result := LDiff - LDiff * Power(100 - LStep, AExp) /
      Power(100, AExp);
  end;

begin
  LDiff := Abs(AEnd - AStart);
  if AStart > AEnd then
    LSign := -1
  else
    LSign := 1;
  LStep := fStep * 100 div fLastLoop;
  case Interpolation of
    intLinear: Result := Exponant(1);
    intQuadratic: Result := Exponant(2);
    intCubic: Result := Exponant(3);
    intQuartic: Result := Exponant(4);
    intQuintic: Result := Exponant(5);
    intSinus: Result := Exponant(1) * sin(pi * LStep / 200);
    intSlowDownQuadratic: Result := DownExponant(2);
    intSlowDownCubic: Result := DownExponant(3);
    intSlowDownQuartic: Result := DownExponant(4);
    intSlowDownQuintic: Result := DownExponant(5);
    intSpring: Result := Exponant(1) * Power(cos(pi * LStep / 100), 2);
    intExpo: Result := Exponant(1) * (Power(2, LStep / 100) - 1);
    intSqrt: Result := Exponant(1) * (Sqrt(LStep) / 10);
    intBounceCos: Result := Exponant(1) + (cos(LStep * pi / 100) + 1) * Exponant(1);
    intSlowDownCos: Result := Exponant(1) + (cos(LStep * pi / 100) + 1) * LStep;
    intStepsCos: Result := Exponant(1) + Power((cos(LStep * pi / 100) + 1), 2) * LStep;
    intCosine: Result := Exponant(1) * (1-cos(LStep/100*Pi))*0.5;
    intHalfCosine: Result := Exponant(1) * ((1-cos(LStep/100*Pi))*0.25 + LStep/100*0.5);
  end;
  Result := AStart + LSign * Result;
end;

function TGVTransition.ComputeInterpolationInt(AStart, AEnd: Single): Integer;
// *** calcul d'une interpolation (entiers) ***
begin
  Result := Round(ComputeInterpolation(AStart, AEnd));
end;

 // état de l'opacité
  TGVOpacityState = (opaNone, opaSource, opaDestination, opaBoth);

property Opacity: TGVOpacityState
      read fOpacityState write SetOpacityState default opaBoth;

procedure TGVTransition.SetOpacityState(AValue: TGVOpacityState);
// *** détermination de l'opacité ***
begin
  if fOpacityState = AValue then
    exit;
  fOpacityState := AValue;
  Change;
end;

function TGVTransition.GetOpacity(Up: Boolean): Integer;
// *** calcul de l'opacité en fonction du pourcentage effectué ***
begin
  Result := ifthen(Up, fStep * C_MaxOpacity div fLastLoop, C_MaxOpacity -
    fStep * C_MaxOpacity div fLastLoop);
end;

function TGVTransition.SourceOpacity: Integer;
// *** opacité pour l'image d'origine ***
begin
  Result := ifthen(fOpacityState in [opaSource, opaBoth], GetOpacity(False), C_MaxOpacity);
end;

function TGVTransition.DestinationOpacity: Integer;
// *** opacité pour l'image de destination ***
begin
  Result := ifthen(fOpacityState in [opaDestination, opaBoth], GetOpacity, C_MaxOpacity);
end;

// rapport entre qualité d'affichage et vitesse
  TGVSmooth = (smoNone, smoHigh, smoMedium, smoLow, smoFast);

procedure TGVTransition.SetSmooth(AValue: TGVSmooth);
// *** lissage des transitions ***
begin
  if fSmooth = AValue then
    Exit;
  fSmooth := AValue;
  case fSmooth of
    smoHigh: begin
      fInc := C_DefaultInc div 2;
      fLastLoop := C_DefaultLastLoop;
    end;
    smoMedium: begin
      fInc := C_DefaultInc;
      fLastLoop := C_DefaultLastLoop;
    end;
    smoNone, smoLow: begin
      fInc := C_DefaultInc;
      fLastLoop := C_DefaultLastLoop div 2;
    end;
    smoFast: begin
      fInc := C_DefaultInc * 2;
      fLastLoop := C_DefaultLastLoop div 2;
    end;
  end;
  Change;
end;

// lissage des transitions
    property Smooth: TGVSmooth read fSmooth write SetSmooth default smoMedium;

{$mode objfpc}{$H+}

// pour ajouter de nouvelles transitions
{.$DEFINE Debug_Transitions}

const
  C_GVVersionSt = '1.0.2.64'; // version
  C_MaxSpeed = 100; // vitesse maximale
  C_DefaultSpeed = C_MaxSpeed div 2; // vitesse par défaut
  C_DefaultTimer = C_DefaultSpeed + 1; // intervalle du timer interne
  C_MaxOpacity = 255;  // opacité maximale
  C_MinVerticalStrips = 1; // minimum de bandes verticales
  C_MinHorizontalStrips = 1; // minimum de bandes horizontales
  C_MaxComputeSize = 1000; // maximum de taille pour le calcul des bandes
  C_MinComputeSize = 10; // minimum de taille pour le calcul des bandes
  C_MinPointsSpline = 4; // minimum de points pour une spline
  C_MinResample = 4; // minimum de la taille d'une image
  C_DefaultWidth = 300; // largeur par défaut du composant
  C_DefaultHeight = C_DefaultWidth * 3 div 4; // hauteur par défaut du composant
  C_DefaultStripWidth = C_DefaultWidth div 10; // largeur d'une bande par défaut
  C_DefaultStripHeight = C_DefaultHeight div 10; // hauteur d'une bande par défaut
  C_DefaultInc = 2;  // incrément accélérateur par défaut
  C_DefaultLastLoop = 96; // dernière boucle par défaut

type
  // interpolations
  TGVInterpolation = (intLinear, intQuadratic, intCubic, intQuartic, intQuintic,
    intSinus, intSlowDownQuadratic, intSlowDownCubic, intSlowDownQuartic,
    intSlowDownQuintic, intSpring, intExpo, intSqrt, intBounceCos, intStepsCos,
    intSlowDownCos, intCosine, intHalfCosine);

  // transitions
  TGVTransitionType = (traNone,
    traUncoverDown, traUncoverUp, traUncoverLeft, traUncoverRight,
    traOverDown, traOverUp, traOverLeft, traOverRight,
    traUncoverBottomRight, traUncoverBottomLeft, traUncoverTopRight, traUncoverTopLeft,
    traUncoverHorizontalBackAndForth, traUncoverVerticalBackAndForth,
    traOverSlipBottomRight, traOverSlipBottomLeft, traOverSlipTopRight,
    traOverSlipTopLeft,
    traOverBottomRight, traOverBottomLeft, traOverTopRight, traOverTopLeft,
    traBottomRightExpand, traBottomLeftExpand, traTopRightExpand, traTopLeftExpand,
    traBottomRightShrink, traBottomLeftShrink, traTopRightShrink, traTopLeftShrink,
    traLeaveUp, traLeaveDown, traLeaveLeft, traLeaveRight,
    traLeaveBottomRight, traLeaveBottomLeft, traLeaveTopRight, traLeaveTopLeft,
    traPushRight, traPushLeft, traPushDown, traPushUp,
    traHorizontalExpand, traVerticalExpand, traHorizontalShrink, traVerticalShrink,
    traRectExpand, traRectShrink,
    traEllipseExpand, traEllipseShrink,
    traDiskExpand, traDiskShrink,
    traCrossExpand, traCrossShrink,
    traShrinkExpandDown, traShrinkExpandUp,
    traTrianglesExpand, traTrianglesShrink,
    traMegaStar,
    traSplinesDown, traSplinesUp, traSplinesRight, traSplinesLeft,
    traStripsDown, traStripsUp, traStripsRight, traStripsLeft,
    traStripsInterlacedLeftRight, traStripsInterlacedRightLeft,
    traStripsInterlacedUpDown, traStripsInterlacedDownUp,
    traRectUpDown, traRectDownUp,
    traWipeRight, traWipeLeft,
    traOverRightSin, traOverLeftSin,
    traBouncingRight, traBouncingLeft, traJumpRight, traJumpLeft,
    traCWRotateRight, traCCWRotateRight, traCCWCenterRotate, traCWCenterRotate,
    traCWRotateLeft, traCCWRotateLeft, traCCWSpiral, traCWSpiral,
    traGrowCenter,
    traGrowBottomRight, traGrowBottomLeft, traGrowTopRight, traGrowTopLeft,
    traGrowCWRotate, traGrowCCWRotate, traGrowCenterCCWRotate, traGrowCenterCWRotate,
    traGrowOverRight, traGrowOverLeft, traGrowOverUp, traGrowOverDown,
    traGrowPushRight, traGrowPushLeft, traGrowPushUp, traGrowPushDown,
    traFadeIn,
    traRotateCCWGrowLeft, traRotateCWGrowLeft,
    traRotateCCWGrowTopLeft, traRotateCWGrowTopLeft,
    traRotateCCWTopLeft, traRotateCWTopLeft,
    traRotateCCWBottomRight, traRotateCWBottomRight,
    traMappingDown, traMappingUp,
    traMultiTwirl, traTwirl,
    traSphere, traCylinderRight, traCylinderLeft,
    traMultiExpand, traMultiExpandTwirl,
    traDrawFromBounds,
    traOffsetTopLeft, traOffsetBottomRight,
    traPixelate, traBlurMotion
    {$IFDEF Debug_Transitions}
    , traDummy
    {$ENDIF}
    );

  // état d'une transition
  TGVTransitionState = (trsWaiting, trsStarting, trsEnding, trsRunning, trsSuspended,
    trsRestarting, trsStopped, trsPaused);

  // état de l'opacité
  TGVOpacityState = (opaNone, opaSource, opaDestination, opaBoth);

  // effets spéciaux (image d'origine)
  TGVSpecialEffect = (speNone, speEmboss, speContour, speNegative, speLinearNegative,
    speSwapRedBlue, speSphere, speRotate, speGrayscale, spePixelate, speTwirl,
    speBlurMotion);

  // qualité des transformations
  TGVQuality = (quaNone, quaLow, quaNormal, quaBest);

  // rapport entre qualité d'affichage et vitesse
  TGVSmooth = (smoNone, smoHigh, smoMedium, smoLow, smoFast);

const
  C_TransitionStateToStr: array[TGVTransitionState] of string =
    ('Waiting', 'Starting', 'Ending', 'Running', 'Suspended', ' Restarting',
    'Stopped', 'Paused');

  C_OpacityStateToStr: array[TGVOpacityState] of string =
    ('None', 'Source', 'Destination', 'Both');

  C_SpecialEffectToStr: array[TGVSpecialEffect] of string =
    ('None', 'Emboss', 'Contour', 'Negative', 'LinearNegative', 'SwapRedBlue', 'Sphere',
    'Rotate', 'Grayscale', 'Pixelate', 'Twirl', 'BlurMotion');

  C_InterpolationToStr: array[TGVInterpolation] of string =
    ('Linear', 'Quadratic', 'Cubic', 'Quartic', 'Quintic',
    'Sinus', 'SlowDownQuadratic', 'SlowDownCubic', 'SlowDownQuartic',
    'SlowDownQuintic', 'Spring', 'Exp', 'Sqrt', 'BounceCos', 'StepsCos',
    'SlowDownCos', 'Cosine', 'HalfCosine');

  C_SmoothToStr: array[TGVSmooth] of string =
    ('None', 'High', 'Medium', 'Low', 'Fast');

  C_QualityToStr: array[TGVQuality] of string =
    ('None', 'Low', 'Normal', 'Best');

  C_TransitionToStr: array[TGVTransitionType] of string =
    ('None',
    'UncoverDown', 'UncoverUp', 'UncoverLeft', 'UncoverRight',
    'OverDown', 'OverUp', 'OverLeft', 'OverRight',
    'UncoverBottomRight', 'UncoverBottomLeft', 'UncoverTopRight', 'UncoverTopLeft',
    'UncoverHorizontalBackAndForth', 'UncoverVerticalBackAndForth',
    'OverSlipBottomRight', 'OverSlipBottomLeft', 'OverSlipTopRight',
    'OverSlipTopLeft',
    'OverBottomRight', 'OverBottomLeft', 'OverTopRight', 'OverTopLeft',
    'BottomRightExpand', 'BottomLeftExpand', 'TopRightExpand', 'TopLeftExpand',
    'BottomRightShrink', 'BottomLeftShrink', 'TopRightShrink', 'TopLeftShrink',
    'LeaveUp', 'LeaveDown', 'LeaveLeft', 'LeaveRight',
    'LeaveBottomRight', 'LeaveBottomLeft', 'LeaveTopRight', 'LeaveTopLeft',
    'PushRight', 'PushLeft', 'PushDown', 'PushUp',
    'HorizontalExpand', 'VerticalExpand', 'HorizontalShrink', 'VerticalShrink',
    'RectExpand', 'RectShrink',
    'EllipseExpand', 'EllipseShrink',
    'DiskExpand', 'DiskShrink',
    'CrossExpand', 'CrossShrink',
    'ShrinkExpandDown', 'ShrinkExpandUp',
    'TrianglesExpand', 'TrianglesShrink',
    'MegaStar',
    'SplinesDown', 'SplinesUp', 'SplinesRight', 'SplinesLeft',
    'StripsDown', 'StripsUp', 'StripsRight', 'StripsLeft',
    'StripsInterlacedLeftRight', 'StripsInterlacedRightLeft',
    'StripsInterlacedUpDown', 'StripsInterlacedDownUp',
    'RectUpDown', 'RectDownUp',
    'WipeRight', 'WipeLeft',
    'OverRightSin', 'OverLeftSin',
    'BouncingRight', 'BouncingLeft', 'JumpRight', 'JumpLeft',
    'CWRotateRight', 'CCWRotateRight', 'CCWCenterRotate', 'CWCenterRotate',
    'CWRotateLeft', 'CCWRotateLeft', 'CCWSpiral', 'CWSpiral',
    'GrowCenter',
    'GrowBottomRight', 'GrowBottomLeft', 'GrowTopRight', 'GrowTopLeft',
    'GrowCWRotate', 'GrowCCWRotate', 'GrowCenterCCWRotate', 'GrowCenterCWRotate',
    'GrowOverRight', 'GrowOverLeft', 'GrowOverUp', 'GrowOverDown',
    'GrowPushRight', 'GrowPushLeft', 'GrowPushUp', 'GrowPushDown',
    'FadeIn',
    'RotateCCWGrowLeft', 'RotateCWGrowLeft',
    'RotateCCWGrowTopLeft', 'RotateCWGrowTopLeft',
    'RotateCCWTopLeft', 'RotateCWTopLeft',
    'RotateCCWBottomRight', 'RotateCWBottomRight',
    'MappingDown', 'MappingUp',
    'MultiTwirl', 'Twirl',
    'Sphere', 'CylinderRight', 'CylinderLeft',
    'MultiExpand', 'MultiExpandTwirl', 'DrawFromBounds',
    'OffsetTopLeft', 'OffsetBottomRight',
    'Pixelate', 'BlurMotion'
    {$IFDEF Debug_Transitions}
    , 'Dummy'
    {$ENDIF}
    );

// chaîne en transition
 function StrToTransitionType(const St: string): TGVTransitionType;
 // chaîne en interpolation
 function StrToInterpolation(const St: string): TGVInterpolation;
 // chaîne en effet spécial
 function StrToSpecialEffect(const St: string): TGVSpecialEffect;
 // chaîne en lissage de l'affichage
 function StrToSmooth(const St: string): TGVSmooth;
 // chaîne en qualité d'affichage
 function StrToQuality(const St: string): TGVQuality;
 // chaîne en type d'opacité
 function StrToOpacity(const St: string): TGVOpacityState;

implementation

uses
  sysutils;

function StrToTransitionType(const St: string): TGVTransitionType;
// *** chaîne en transition ***
var
  LTra: TGVTransitionType;
begin
  Result := traNone;
  for LTra := low(TGVTransitionType) to high(TGVTransitionType) do
    if CompareText(St, C_TransitionToStr[LTra]) = 0 then
    begin
      Result := LTra;
      exit;
    end;
end;

function StrToInterpolation(const St: string): TGVInterpolation;
// *** chaîne en interpolation ***
var
  LInt: TGVInterpolation;
begin
  Result := intLinear;
  for LInt := low(TGVInterpolation) to high(TGVInterpolation) do
    if CompareText(St, C_InterpolationToStr[LInt]) = 0 then
    begin
      Result := LInt;
      exit;
    end;
end;

function StrToSpecialEffect(const St: string): TGVSpecialEffect;
// *** chaîne en effet spécial ***
var
  LSpeEffect: TGVSpecialEffect;
begin
  Result := speNone;
  for LSpeEffect := low(TGVSpecialEffect) to high(TGVSpecialEffect) do
    if CompareText(St, C_SpecialEffectToStr[LSpeEffect]) = 0 then
    begin
      Result := LSpeEffect;
      exit;
    end;
end;

function StrToSmooth(const St: string): TGVSmooth;
// *** chaîne en lissage de l'affichage ***
var
  LSmooth: TGVSmooth;
begin
  Result := smoNone;
  for LSmooth := low(TGVSmooth) to high(TGVSmooth) do
    if CompareText(St, C_SmoothToStr[LSmooth]) = 0 then
    begin
      Result := LSmooth;
      exit;
    end;
end;

function StrToQuality(const St: string): TGVQuality;
// *** chaîne en qualité d'affichage ***
var
  LQuality: TGVQuality;
begin
  Result := quaNone;
  for LQuality := low(TGVQuality) to high(TGVQuality) do
    if CompareText(St, C_QualityToStr[LQuality]) = 0 then
    begin
      Result := LQuality;
      exit;
    end;
end;

function StrToOpacity(const St: string): TGVOpacityState;
// *** chaîne en type d'opacité ***
var
  LOpa: TGVOpacityState;
begin
  Result := opaNone;
  for LOpa := low(TGVOpacityState) to high(TGVOpacityState) do
    if CompareText(St, C_OpacityStateToStr[LOpa]) = 0 then
    begin
      Result := LOpa;
      exit;
    end;
end;

end.