बजाना कार्ड फ्लिप एनीमेशन

Question

क्या आप किसी भी मुफ्त घटक/पुस्तकालयों के बारे में जानते हैं, जो 3 डी फ्लिप प्रभाव प्राप्त करने की अनुमति देते हैं?

यहाँ डेमो: snorkl.tv

Answer 1

कुछ इस तरह समान प्रभाव (सिर्फ एक और दिखाने के लिए यह कैसे किया जा सकता है, यह भी तो सटीक नहीं है, लेकिन यह सिर्फ मनोरंजन के लिए है, क्योंकि आप एक पुस्तकालय के लिए पूछा है प्रयास कर सकते हैं या घटक)।

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. 

: सिद्धांत एक rectnagle जाता है कि आकार दिया और जा रहा है पर आधारित है रंग बॉक्स जहां कार्ड StretchDraw समारोह साथ गाया जा रहा है में केंद्रित यूनिट 1.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 

कार्ड

Answer 2

यहाँ एक प्रयास 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; 

मैं अगर यह बाहर बदल कुछ भी मामले में सुंदर होने के लिए का एक मौका खड़ा था यकीन नहीं है मेरे पास कुछ गणित क्षमता थी, लेकिन वर्तमान में यह कैसा दिखता है:



छवियों का इस्तेमाल: