Phát hoạt ảnh lật thẻ

Question

Bạn có biết bất kỳ thành phần/thư viện miễn phí nào cho phép đạt hiệu ứng lật 3D không?

Demo đây: snorkl.tv

Answer 1

Something như thế này có thể làm ảnh hưởng tương tự (chỉ là một nỗ lực để chứng tỏ điều này có thể được thực hiện, cũng không quá chính xác, nhưng nó chỉ để cho vui vì bạn đã yêu cầu thư viện hoặc thành phần). Nguyên tắc được dựa trên một rectnagle đang được thay đổi kích cỡ và trung trong hộp sơn nơi thẻ được trả lại với StretchDraw chức năng:

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 

Thẻ

Answer 2

Dưới đây là một nỗ lực sử dụng 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; 

Tôi không chắc chắn nếu điều này đứng cơ hội quay ra được bất cứ điều gì đẹp trong trường hợp Tôi đã có một số khả năng toán học, nhưng đây là giao diện của nó:



Các hình ảnh được sử dụng: