Animación de volteo de tarjeta

Question

¿Conoce algún componente/librería libre que permita obtener un efecto de volteo 3D?

demo aquí: snorkl.tv

Answer 1

Algo como esto podría hacer el efecto similar (más que otro intento de mostrar cómo esto podría hacerse, también no tan precisa, pero es sólo por diversión, ya lo solicitado una biblioteca o componente). El principio se basa en un rectnagle que se está cambiando el tamaño y centrado en el cuadro de pintura, donde la tarjeta es que se queden con la función StretchDraw:

Unit1.pas

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, ExtCtrls, PNGImage; 

type 
    TCardSide = (csBack, csFront); 
    TForm1 = class(TForm) 
    Timer1: TTimer; 
    Timer2: TTimer; 
    PaintBox1: TPaintBox; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure Timer2Timer(Sender: TObject); 
    procedure PaintBox1Click(Sender: TObject); 
    procedure PaintBox1Paint(Sender: TObject); 
    private 
    FCardRect: TRect; 
    FCardSide: TCardSide; 
    FCardBack: TPNGImage; 
    FCardFront: TPNGImage; 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    FCardSide := csBack; 
    FCardRect := PaintBox1.ClientRect; 
    FCardBack := TPNGImage.Create; 
    FCardBack.LoadFromFile('tps2N.png'); 
    FCardFront := TPNGImage.Create; 
    FCardFront.LoadFromFile('Ey3cv.png'); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    FCardBack.Free; 
    FCardFront.Free; 
end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
    if FCardRect.Right - FCardRect.Left > 0 then 
    begin 
    FCardRect.Left := FCardRect.Left + 3; 
    FCardRect.Right := FCardRect.Right - 3; 
    PaintBox1.Invalidate; 
    end 
    else 
    begin 
    Timer1.Enabled := False; 
    case FCardSide of 
     csBack: FCardSide := csFront; 
     csFront: FCardSide := csBack; 
    end; 
    Timer2.Enabled := True; 
    end; 
end; 

procedure TForm1.Timer2Timer(Sender: TObject); 
begin 
    if FCardRect.Right - FCardRect.Left < PaintBox1.ClientWidth then 
    begin 
    FCardRect.Left := FCardRect.Left - 3; 
    FCardRect.Right := FCardRect.Right + 3; 
    PaintBox1.Invalidate; 
    end 
    else 
    Timer2.Enabled := False; 
end; 

procedure TForm1.PaintBox1Click(Sender: TObject); 
begin 
    Timer1.Enabled := False; 
    Timer2.Enabled := False; 
    FCardRect := PaintBox1.ClientRect; 
    Timer1.Enabled := True; 
    PaintBox1.Invalidate; 
end; 

procedure TForm1.PaintBox1Paint(Sender: TObject); 
begin 
    case FCardSide of 
    csBack: PaintBox1.Canvas.StretchDraw(FCardRect, FCardBack); 
    csFront: PaintBox1.Canvas.StretchDraw(FCardRect, FCardFront); 
    end; 
end; 

end. 

Unit1.dfm

object Form1: TForm1 
    Left = 0 
    Top = 0 
    Caption = 'Form1' 
    ClientHeight = 203 
    ClientWidth = 173 
    Color = clBtnFace 
    DoubleBuffered = True 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    Position = poScreenCenter 
    OnCreate = FormCreate 
    OnDestroy = FormDestroy 
    PixelsPerInch = 96 
    TextHeight = 13 
    object PaintBox1: TPaintBox 
    Left = 48 
    Top = 40 
    Width = 77 
    Height = 121 
    OnClick = PaintBox1Click 
    OnPaint = PaintBox1Paint 
    end 
    object Timer1: TTimer 
    Enabled = False 
    Interval = 10 
    OnTimer = Timer1Timer 
    Left = 32 
    Top = 88 
    end 
    object Timer2: TTimer 
    Enabled = False 
    Interval = 10 
    OnTimer = Timer2Timer 
    Left = 88 
    Top = 88 
    end 
end 

Tarjetas

Answer 2

He aquí un intento de utilizar SetWorldTransform:

type 
    TForm1 = class(TForm) 
    PaintBox1: TPaintBox; 
    Button1: TButton; 
    Timer1: TTimer; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure PaintBox1Paint(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    private 
    FFrontBmp, FBackBmp: TBitmap; 
    FBmps: array [Boolean] of TBitmap; 
    FXForm: TXForm; 
    FStep: Integer; 
    end; 

var 
    Form1: TForm1; 

implementation 

uses 
    Math; 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    FFrontBmp := TBitmap.Create; 
    FFrontBmp.LoadFromFile(ExtractFilePath(Application.ExeName) + '53.bmp'); 
    FBackBmp := TBitmap.Create; 
    FBackBmp.LoadFromFile(ExtractFilePath(Application.ExeName) + 'b1fv.bmp'); 
    FBmps[True] := FFrontBmp; 
    FBmps[False] := FBackBmp; 

    FXForm.eM11 := 1; 
    FXForm.eM12 := 0; 
    FXForm.eM21 := 0; 
    FXForm.eM22 := 1; 
    FXForm.eDx := 0; 
    FXForm.eDy := 0; 

    Timer1.Enabled := False; 
    Timer1.Interval := 30; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    FFrontBmp.Free; 
    FBackBmp.Free; 
end; 

procedure TForm1.PaintBox1Paint(Sender: TObject); 
begin 
    SetGraphicsMode(PaintBox1.Canvas.Handle, GM_ADVANCED); 
    SetWorldTransform(PaintBox1.Canvas.Handle, FXForm); 
    PaintBox1.Canvas.Draw(0, 0, FBmps[FStep < 20]); 
end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
var 
    Bmp: TBitmap; 
    Sign: Integer; 
begin 
    Inc(FStep); 

    Sign := math.Sign(FStep - 20); 
    FXForm.eM11 := FXForm.eM11 + 0.05 * Sign; 
    FXForm.eM21 := FXForm.eM21 - 0.005 * Sign; 
    FXForm.eDx := FXForm.eDx - 1 * Sign; 
    if FStep = 39 then begin 
    Timer1.Enabled := False; 
    PaintBox1.Refresh; 
    end else 
    PaintBox1.Invalidate; 

    if not Timer1.Enabled then begin 
    Bmp := FBmps[True]; 
    FBmps[True] := FBmps[False]; 
    FBmps[False] := Bmp; 
    end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    Timer1.Enabled := True; 
    FStep := 0; 
end; 

No estoy seguro si esto tuvo una oportunidad de convertir a ser algo hermoso en el caso Tenía algunas capacidades matemáticas, pero aquí está cómo se ve actualmente:



las imágenes utilizadas: