Animazione flip scheda di gioco

Question

Conoscete eventuali componenti/librerie liberi che consentono di ottenere un effetto vibrazione 3D?

Demo qui: snorkl.tv

Answer 1

Qualcosa di simile potrebbe fare l'effetto simile (solo un altro tentativo di mostrare come questo potrebbe essere fatto, inoltre, non così preciso, ma è solo per divertimento dal momento che hai chiesto per una libreria o componente). Il principio si basa su un rectnagle che viene ridimensionato e centrato nella scatola di colori in cui la carta viene reso con la funzione 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 

Carte

Answer 2

Ecco un tentativo utilizzando 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; 

io non sono sicuro se questo si trovava una possibilità di svolta a essere nulla di bello nel caso in cui Ho avuto alcune capacità matematiche, ma ecco come appare attualmente:



Le immagini utilizzate: