Develop and Download Open Source Software

Browse Subversion Repository

Contents of /trunk/Unit4.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (show annotations) (download) (as text)
Sun May 3 07:26:15 2015 UTC (9 years ago) by yamat0jp
File MIME type: text/x-pascal
File size: 3523 byte(s)
間違えてばかりでしたがこちらが正しいURLです
1 unit Unit4;
2
3 interface
4
5 uses
6 System.SysUtils, System.Types, System.UITypes, System.Classes,
7 System.Variants,
8 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
9 ocv.comp.Types, ocv.comp.VideoWriter, ocv.comp.Source,
10 ocv.comp.ImageOperation, FMX.Effects, System.TypInfo, ocv.core.types_c,
11 ocv.core_c,
12 ocv.highgui_c, FMX.Controls.Presentation, FMX.Edit, FMX.EditBox, FMX.SpinBox;
13
14 type
15 TForm4 = class(TForm)
16 Button1: TButton;
17 Button2: TButton;
18 SaveDialog1: TSaveDialog;
19 Edit1: TEdit;
20 Button3: TButton;
21 Label1: TLabel;
22 SpinBox1: TSpinBox;
23 SpinBox2: TSpinBox;
24 ProgressBar1: TProgressBar;
25 ShadowEffect1: TShadowEffect;
26 procedure Button1Click(Sender: TObject);
27 procedure Button3Click(Sender: TObject);
28 procedure FormShow(Sender: TObject);
29 private
30 { private éŒž }
31 public
32 { public éŒž }
33 end;
34
35 var
36 Form4: TForm4;
37
38 implementation
39
40 {$R *.fmx}
41
42 uses Unit1;
43
44 procedure TForm4.Button1Click(Sender: TObject);
45 var
46 i: Integer;
47 s: TEffect;
48 j: Integer;
49 Image: PIplImage;
50 BD: TBitmapData;
51 vw: pCvVideoWriter;
52 cvs: TCvSize;
53 const
54 fps: Integer = 30;
55 procedure Map;
56 begin
57 with Form1.Image1 do
58 begin
59 Bitmap.Map(TMapAccess.Read, BD);
60 Move(BD.data^, Image^.imageData^, Image^.imageSize);
61 Bitmap.Unmap(BD);
62 end;
63 end;
64
65 begin
66 if ProgressBar1.Value > 0 then
67 Exit;
68 if FileExists(Edit1.Text) = true then
69 DeleteFile(Edit1.Text);
70 Randomize;
71 Caption := 'ˆ—’†‚Ĺ‚ˇ.';
72 Form1.Image1.Visible := false;
73 Button1.Enabled:=false;
74 cvs := cvSize(Form1.Image1.Bitmap.Width, Form1.Image1.Bitmap.Height);
75 // cvSize(Round(SpinBox1.Value), Round(SpinBox2.Value));
76 Image := cvCreateImage(cvs, IPL_DEPTH_8U, 3);
77 vw := cvCreateVideoWriter(PAnsiChar(AnsiString(Edit1.Text)), CV_FOURCC('X','V','I','D'), fps, cvs);
78 try
79 for j := 0 to Form1.ListView1.ItemCount - 2 do
80 begin
81 s := Form1.Image1.Children[Random(Form1.Image1.ChildrenCount)] as TEffect;
82 SetPropValue(s, 'Progress', 0);
83 SetObjectProp(s, 'target', Form1.ListView1.Items[j + 1].Bitmap);
84 Form1.Image1.Bitmap.Assign(Form1.ListView1.Items[j].Bitmap);
85 Map;
86 for i := 1 to Round(fps * Form1.FloatAnimation1.Delay) do
87 cvWriteFrame(vw, Image);
88 for i := 1 to 100 do
89 begin
90 Form1.Image1.Bitmap.Assign(Form1.ListView1.Items[j].Bitmap);
91 SetPropValue(s, 'Progress', i);
92 s.ProcessEffect(Form1.Image1.Bitmap.Canvas, Form1.Image1.Bitmap, 1);
93 Map;
94 cvWriteFrame(vw, Image);
95 end;
96 ProgressBar1.Value := j;
97 Application.ProcessMessages;
98 if ModalResult = mrCancel then
99 Abort;
100 s.Enabled := false;
101 end;
102 for i := 1 to Round(fps * Form1.FloatAnimation1.Delay) do
103 cvWriteFrame(vw, Image);
104 ProgressBar1.Value := ProgressBar1.Max;
105 finally
106 cvRelease(Pointer(Image));
107 cvReleaseVideoWriter(vw);
108 Form1.Image1.Visible := true;
109 Button1.Enabled:=true;
110 end;
111 end;
112
113 procedure TForm4.Button3Click(Sender: TObject);
114 begin
115 if SaveDialog1.Execute = true then
116 begin
117 Edit1.Text := SaveDialog1.FileName;
118 ShadowEffect1.Enabled := true;
119 end
120 else
121 ShadowEffect1.Enabled := false;
122 end;
123
124 procedure TForm4.FormShow(Sender: TObject);
125 begin
126 ProgressBar1.Value := 0;
127 ProgressBar1.Max := Form1.ListView1.ItemCount;
128 Caption := 'ĹIÝ’č';
129 end;
130
131 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26