玩卡片翻转动画 [英] Playing card flip animation
问题描述
此处演示: snorkl.tv
像这样的事情可能会产生类似的效果(只是另一个尝试来显示如何做到这一点,也不是那么精确,但是由于您要求库或组件,所以只是为了好玩)。这个原则是基于一个正在调整大小的角形,并且在使用 StretchDraw
函数渲染卡的绘画框中 p>
Unit1.pas
c $ c> unit Unit1;
接口
使用
Windows,消息,SysUtils,变体,类,图形,控件,窗体,
对话框,StdCtrls,ExtCtrls,PNGImage;
type
TCardSide =(csBack,csFront);
TForm1 = class(TForm)
Timer1:TTimer;
Timer2:TTimer;
PaintBox1:TPaintBox;
procedure FormCreate(Sender:TObject);
procedure FormDestroy(Sender:TObject);
程序Timer1Timer(Sender:TObject);
procedure Timer2Timer(Sender:TObject);
程序PaintBox1Click(Sender:TObject);
procedure PaintBox1Paint(Sender:TObject);
private
FCardRect:TRect;
FCardSide:TCardSide;
FCardBack:TPNGImage;
FCardFront:TPNGImage;
public
{公开声明}
end;
var
Form1:TForm1;
实现
{$ R * .dfm}
程序TForm1.FormCreate(发件人:TObject);
begin
FCardSide:= csBack;
FCardRect:= PaintBox1.ClientRect;
FCardBack:= TPNGImage.Create;
FCardBack.LoadFromFile('tps2N.png');
FCardFront:= TPNGImage.Create;
FCardFront.LoadFromFile('Ey3cv.png');
结束
procedure TForm1.FormDestroy(Sender:TObject);
begin
FCardBack.Free;
FCardFront.Free;
结束
程序TForm1.Timer1Timer(Sender:TObject);
begin
如果FCardRect.Right - FCardRect.Left> 0然后
begin
FCardRect.Left:= FCardRect.Left + 3;
FCardRect.Right:= FCardRect.Right - 3;
PaintBox1.Invalidate;
end
else
begin
Timer1.Enabled:= False;
case FCardSide
csBack:FCardSide:= csFront;
csFront:FCardSide:= csBack;
结束
Timer2.Enabled:= True;
结束
结束
procedure TForm1.Timer2Timer(Sender:TObject);
begin
如果FCardRect.Right - FCardRect.Left< PaintBox1.ClientWidth然后
begin
FCardRect.Left:= FCardRect.Left - 3;
FCardRect.Right:= FCardRect.Right + 3;
PaintBox1.Invalidate;
end
else
Timer2.Enabled:= False;
结束
程序TForm1.PaintBox1Click(Sender:TObject);
begin
Timer1.Enabled:= False;
Timer2.Enabled:= False;
FCardRect:= PaintBox1.ClientRect;
Timer1.Enabled:= True;
PaintBox1.Invalidate;
结束
procedure TForm1.PaintBox1Paint(Sender:TObject);
begin
case FCardSide of
csBack:PaintBox1.Canvas.StretchDraw(FCardRect,FCardBack);
csFront:PaintBox1.Canvas.StretchDraw(FCardRect,FCardFront);
结束
结束
结束。
Unit1.dfm
对象Form1:TForm1
Left = 0
顶部= 0
Caption ='Form1'
ClientHeight = 203
ClientWidth = 173
颜色= 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
对象PaintBox1:TPaintBox
左= 48
顶部= 40
宽度= 77
高度= 121
OnClick = PaintBox1Click
OnPaint = PaintBox1Paint
end
对象Timer1:TTimer
Enabled = False
Interval = 10
OnTimer = Timer1Timer
Left = 32
顶部= 88
end
对象Timer2:TTimer
已启用= False
间隔= 10
OnTimer = Timer2Timer
左= 88
顶部= 88
结束
结束
卡片
img src =https://i.stack.imgur.com/tps2N.pngalt =在此输入图像说明>
Do you know of any free components/libraries, which allow to achieve a 3D flip effect?
Demo here: snorkl.tv
Something like this might do the similar effect (just another attempt to show how this could be done, also not so precise, but it's just for fun since you've asked for a library or component). The principle is based on a rectnagle that is being resized and centered in the paint box where the card is being rendered with the StretchDraw
function:
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
Cards
这篇关于玩卡片翻转动画的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!