Develop and Download Open Source Software

Browse Subversion Repository

Contents of /trunk/Unit1.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: 8811 byte(s)
間違えてばかりでしたがこちらが正しいURLです
1 unit Unit1;
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,
9 Data.Bind.EngExt, FMX.Bind.DBEngExt, System.Rtti, System.Bindings.Outputs,
10 FMX.Bind.Editors, Data.Bind.Components, FMX.StdCtrls, FMX.Effects,
11 FMX.Filter.Effects, FMX.Ani, FMX.Objects, FMX.Menus, FMX.ListView.Types,
12 FMX.ListView, FMX.Layouts, FMX.ListBox,
13 FMX.Controls.Presentation, FMX.Edit, FMX.EditBox, FMX.SpinBox, FMX.Media,
14 Math;
15
16 type
17 TForm1 = class(TForm)
18 BlurTransitionEffect1: TBlurTransitionEffect;
19 Image1: TImage;
20 Timer1: TTimer;
21 BandedSwirlTransitionEffect1: TBandedSwirlTransitionEffect;
22 MainMenu1: TMainMenu;
23 BlindTransitionEffect1: TBlindTransitionEffect;
24 CircleTransitionEffect1: TCircleTransitionEffect;
25 MagnifyTransitionEffect1: TMagnifyTransitionEffect;
26 CrumpleTransitionEffect1: TCrumpleTransitionEffect;
27 DissolveTransitionEffect1: TDissolveTransitionEffect;
28 DropTransitionEffect1: TDropTransitionEffect;
29 FadeTransitionEffect1: TFadeTransitionEffect;
30 BrightTransitionEffect1: TBrightTransitionEffect;
31 PixelateTransitionEffect1: TPixelateTransitionEffect;
32 WiggleTransitionEffect1: TWiggleTransitionEffect;
33 ShapeTransitionEffect1: TShapeTransitionEffect;
34 RippleTransitionEffect1: TRippleTransitionEffect;
35 RotateCrumpleTransitionEffect1: TRotateCrumpleTransitionEffect;
36 SaturateTransitionEffect1: TSaturateTransitionEffect;
37 SlideTransitionEffect1: TSlideTransitionEffect;
38 SwirlTransitionEffect1: TSwirlTransitionEffect;
39 WaterTransitionEffect1: TWaterTransitionEffect;
40 WaveTransitionEffect1: TWaveTransitionEffect;
41 LineTransitionEffect1: TLineTransitionEffect;
42 FloatAnimation1: TFloatAnimation;
43 ListView1: TListView;
44 Button1: TButton;
45 OpenDialog1: TOpenDialog;
46 Button2: TButton;
47 MenuItem1: TMenuItem;
48 MenuItem2: TMenuItem;
49 MenuItem3: TMenuItem;
50 MenuItem4: TMenuItem;
51 MenuItem5: TMenuItem;
52 MenuItem6: TMenuItem;
53 ComboBox1: TComboBox;
54 MenuItem7: TMenuItem;
55 MenuItem8: TMenuItem;
56 MenuItem9: TMenuItem;
57 MenuItem10: TMenuItem;
58 Button3: TButton;
59 MenuItem11: TMenuItem;
60 SpinBox1: TSpinBox;
61 Label1: TLabel;
62 Label2: TLabel;
63 MediaPlayer1: TMediaPlayer;
64 Label3: TLabel;
65 MenuItem12: TMenuItem;
66 Panel1: TPanel;
67 Panel2: TPanel;
68 Panel3: TPanel;
69 MenuItem13: TMenuItem;
70 BlurEffect1: TBlurEffect;
71 MenuItem14: TMenuItem;
72 procedure Button1Click(Sender: TObject);
73 procedure Button2Click(Sender: TObject);
74 procedure ListView1Change(Sender: TObject);
75 procedure FormCreate(Sender: TObject);
76 procedure FloatAnimation1Finish(Sender: TObject);
77 procedure MenuItem5Click(Sender: TObject);
78 procedure MenuItem8Click(Sender: TObject);
79 procedure Button3Click(Sender: TObject);
80 procedure SpinBox1Change(Sender: TObject);
81 procedure MenuItem12Click(Sender: TObject);
82 procedure MenuItem13Click(Sender: TObject);
83 procedure ListView1DblClick(Sender: TObject);
84 procedure MenuItem3Click(Sender: TObject);
85 procedure MenuItem14Click(Sender: TObject);
86 private
87 progress: Boolean;
88 { private ���� }
89 public
90 { public ���� }
91 end;
92
93 var
94 Form1: TForm1;
95
96 implementation
97
98 {$R *.fmx}
99
100 uses Unit2, Unit3, Unit4;
101
102 procedure TForm1.Button1Click(Sender: TObject);
103 var
104 s: TListViewItem;
105 t: string;
106 begin
107 if OpenDialog1.Execute = true then
108 begin
109 for t in OpenDialog1.Files do
110 begin
111 s := ListView1.Items.Add;
112 s.Text := ExtractFileName(t);
113 s.Detail := t;
114 s.Bitmap.LoadFromFile(t);
115 end;
116 if ListView1.ItemCount > 0 then
117 begin
118 ListView1.ItemIndex := 0;
119 Image1.Bitmap.Assign(ListView1.Items[0].Bitmap);
120 Randomize;
121 end;
122 end;
123 end;
124
125 procedure TForm1.Button2Click(Sender: TObject);
126 var
127 s: TFmxObject;
128 i: Integer;
129 Context: TRttiContext;
130 RttiType: TRttiType;
131 begin
132 if (ListView1.ItemIndex > -1) and (ComboBox1.Items.Count > 0) and
133 (ListView1.ItemIndex < ListView1.ItemCount - 1) then
134 begin
135 if FloatAnimation1.Running = true then
136 begin
137 progress := true;
138 FloatAnimation1.Stop;
139 end;
140 Context := TRttiContext.Create;
141 for s in Image1.Children do
142 if s.ClassName = ComboBox1.Items[ComboBox1.ItemIndex] then
143 begin
144 FloatAnimation1.Parent := s;
145 RttiType := Context.GetType(s.ClassType);
146 RttiType.GetProperty('Target')
147 .SetValue(s, ListView1.Items[ListView1.ItemIndex + 1].Bitmap);
148 RttiType.GetProperty('Progress').SetValue(s, 0);
149 (s as TEffect).Enabled := true;
150 FloatAnimation1.Start;
151 if Sender = Button2 then
152 MediaPlayer1.Play;
153 break;
154 end;
155 Context.Free;
156 end;
157 end;
158
159 procedure TForm1.Button3Click(Sender: TObject);
160 var
161 i: Integer;
162 begin
163 for i := ListView1.Items.Count - 1 downto 0 do
164 if ListView1.Items[i].Checked = true then
165 ListView1.Items.Delete(i);
166 if ListView1.ItemCount = 0 then
167 Image1.Bitmap.Clear(Fill.Color);
168 end;
169
170 procedure TForm1.FloatAnimation1Finish(Sender: TObject);
171 begin
172 (FloatAnimation1.Parent as TEffect).Enabled := false;
173 if (ListView1.ItemIndex < ListView1.ItemCount - 1) and (progress = false) then
174 begin
175 ListView1.ItemIndex := ListView1.ItemIndex + 1;
176 Image1.Bitmap.Assign(ListView1.Items[ListView1.ItemIndex].Bitmap);
177 if ListView1.ItemIndex < ListView1.ItemCount - 1 then
178 begin
179 ComboBox1.ItemIndex := Random(ComboBox1.Items.Count);
180 FloatAnimation1.Stop;
181 Button2Click(Sender);
182 end;
183 end
184 else
185 begin
186 progress := false;
187 MediaPlayer1.Stop;
188 end;
189 end;
190
191 procedure TForm1.FormCreate(Sender: TObject);
192 var
193 i: Integer;
194 begin
195 for i := 0 to Image1.ChildrenCount - 1 do
196 ComboBox1.Items.Add(Image1.Children[i].ClassName);
197 ComboBox1.ItemIndex := 0;
198 end;
199
200 procedure TForm1.ListView1Change(Sender: TObject);
201 begin
202 if FloatAnimation1.Running = true then
203 begin
204 progress := true;
205 FloatAnimation1.Stop;
206 end;
207 SpinBox1Change(Sender);
208 if (Form3.CheckBox1.IsChecked = true) and
209 (MediaPlayer1.CurrentTime > MediaPlayer1.Duration) then
210 MediaPlayer1.CurrentTime :=
211 MediaPlayer1.CurrentTime mod MediaPlayer1.Duration;
212 Image1.Bitmap.Assign(ListView1.Items[ListView1.ItemIndex].Bitmap);
213 end;
214
215 procedure TForm1.ListView1DblClick(Sender: TObject);
216 var
217 i: Integer;
218 begin
219 i := ListView1.ItemIndex;
220 ListView1.Items[i].Checked := not ListView1.Items[i].Checked;
221 end;
222
223 procedure TForm1.MenuItem12Click(Sender: TObject);
224 begin
225 if Form3.ShowModal = mrOK then
226 if Form3.FIleName = '' then
227 begin
228 MediaPlayer1.Clear;
229 Label3.Text := '�����t�@�C���F' + '����';
230 end
231 else
232 begin
233 MediaPlayer1.FIleName := Form3.FIleName;
234 if Form3.Switch1.IsChecked = true then
235 MediaPlayer1.Volume := 0
236 else
237 MediaPlayer1.Volume := Form3.MediaPlayer1.Volume;
238 Label3.Text := '�����t�@�C���F' + ExtractFileName(Form3.FIleName);
239 end;
240 end;
241
242 procedure TForm1.MenuItem13Click(Sender: TObject);
243 begin
244 if ListView1.ItemCount > 0 then
245 begin
246 // BlurEffect1.Enabled := true;
247 Image1.Visible:=false;
248 try
249 Form4.ShowModal;
250 finally
251 BlurEffect1.Enabled := false;
252 Image1.Visible:=true;
253 end;
254 end;
255 end;
256
257 procedure TForm1.MenuItem14Click(Sender: TObject);
258 begin
259 ListView1.Items.Clear;
260 end;
261
262 procedure TForm1.MenuItem3Click(Sender: TObject);
263 begin
264 MenuItem13.IsChecked:=ListView1.ItemCount > 0;
265 end;
266
267 procedure TForm1.MenuItem5Click(Sender: TObject);
268 begin
269 Close;
270 end;
271
272 procedure TForm1.MenuItem8Click(Sender: TObject);
273 var
274 s: string;
275 i: Integer;
276 begin
277 if ComboBox1.Items.Count > 0 then
278 s := ComboBox1.Items[ComboBox1.ItemIndex];
279 if Form2.ShowModal = mrOK then
280 begin
281 ComboBox1.Items.Assign(Form2.ListBox2.Items);
282 i := ComboBox1.Items.IndexOf(s);
283 if i > -1 then
284 ComboBox1.ItemIndex := i
285 else if ComboBox1.Items.Count > 0 then
286 ComboBox1.ItemIndex := 0;
287 end;
288 end;
289
290 procedure TForm1.SpinBox1Change(Sender: TObject);
291 begin
292 with FloatAnimation1 do
293 begin
294 if Running = true then
295 begin
296 progress := true;
297 Stop;
298 end;
299 Delay := SpinBox1.Value - Duration;
300 end;
301 if ListView1.Items.Count > 0 then
302 MediaPlayer1.CurrentTime := Floor(SpinBox1.Value * MediaPlayer1.Duration *
303 MediaTimeScale * ListView1.ItemIndex / ListView1.Items.Count);
304 Label2.Visible := SpinBox1.Value = SpinBox1.Min;
305 end;
306
307 end.

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