扑克牌翻转动画

Question

您知道任何可以实现3D翻转效果的免费组件/库吗？

在这里演示：snorkl.tv

Answer 1

以下是使用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;

我不确定这是否有机会在我有数学能力的情况下变成美丽的东西，但目前的情况如下：



使用的图像：

Answer 2

这样的事情可能会产生类似的效果（只是另一次试图展示如何做到这一点，也不是那么精确，但它只是为了好玩，因为你已经要求一个库或组件）。该原则基于一个尺寸正确的rectnagle，并且在使用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

<强> 卡