Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /trunk/vobslideshow/Unit4.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4 - (hide annotations) (download) (as text)
Sat May 2 12:45:33 2015 UTC (8 years, 11 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 3557 byte(s)
利用できる状態ではありません
URLを訂正します
1 yamat0jp 4 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)), 0, 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     begin
100     ProgressBar1.Value := 0;
101     Abort;
102     end;
103     s.Enabled := false;
104     end;
105     for i := 1 to Round(fps * Form1.FloatAnimation1.Delay) do
106     cvWriteFrame(vw, Image);
107     ProgressBar1.Value := ProgressBar1.Max;
108     finally
109     cvRelease(Pointer(Image));
110     cvReleaseVideoWriter(vw);
111     Form1.Image1.Visible := true;
112     Button1.Enabled:=true;
113     end;
114     end;
115    
116     procedure TForm4.Button3Click(Sender: TObject);
117     begin
118     if SaveDialog1.Execute = true then
119     begin
120     Edit1.Text := SaveDialog1.FileName;
121     ShadowEffect1.Enabled := true;
122     end
123     else
124     ShadowEffect1.Enabled := false;
125     end;
126    
127     procedure TForm4.FormShow(Sender: TObject);
128     begin
129     ProgressBar1.Value := 0;
130     ProgressBar1.Max := Form1.ListView1.ItemCount;
131     Caption := 'ĹIÝ’č';
132     end;
133    
134     end.

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