Spielkarte Flip-Animation

Question

Kennen Sie irgendwelche freie Komponenten/Bibliotheken, die es ermöglichen, einen 3D-Flip-Effekt zu erzielen?

Demo hier: snorkl.tv

Answer 1

Etwas Ähnliches könnte einen ähnlichen Effekt tun (nur einen weiteren Versuch, zu zeigen, wie dies geschehen könnte, auch nicht so genau, aber es ist nur zum Spaß, da Sie für eine Bibliothek gefragt haben oder Komponente). Das Prinzip basiert auf einem rectnagle, die die Größe verändert und wird zentriert im Malkasten, wo die Karte mit der StretchDraw Funktion wiedergegeben wird:

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 

Karten

Answer 2

Hier ist ein Versuch mit 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; 

Ich bin mir nicht sicher, ob dies eine Chance, Ausdrehen zu sein, alles schön im Fall stand Ich hatte etwas Mathe-Fähigkeit, aber hier ist derzeit, wie es aussieht:



Die verwendeten Bilder: