Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 9 - (hide annotations) (download) (as text)
Wed Jan 13 11:20:13 2016 UTC (8 years, 2 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 13276 byte(s)
ダイアログの問題があっさり解決
IntrawebのDemoにあるそうですが本ソフトでも同じことをしています、参考にしてください
1 yamat0jp 1 unit Unit1;
2    
3     interface
4    
5     uses
6 yamat0jp 2 Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWVCLComponent,
7     IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
8     IWTemplateProcessorHTML, Vcl.Controls, Vcl.Forms, Unit2, IWVCLBaseContainer,
9     IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,
10 yamat0jp 1 IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
11 yamat0jp 2 IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12 yamat0jp 8 IWHTMLControls, IWCompExtCtrls, PngImage, Data.DB,
13 yamat0jp 3 IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14 yamat0jp 8 IWCompMenu, Vcl.Menus, System.Variants, Vcl.Dialogs, System.UITypes, Unit8;
15 yamat0jp 1
16     type
17 yamat0jp 2 TIWForm1 = class(TIWAppForm)
18     IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
19     IWLabel1: TIWLabel;
20     IWDBLabel1: TIWDBLabel;
21 yamat0jp 1 IWRegion1: TIWRegion;
22 yamat0jp 2 IWRegion2: TIWRegion;
23     IWText1: TIWText;
24     IWGrid1: TIWGrid;
25     IWRegion3: TIWRegion;
26     IWRegion4: TIWRegion;
27 yamat0jp 1 IWLink1: TIWLink;
28     IWLabel2: TIWLabel;
29 yamat0jp 2 IWList1: TIWList;
30 yamat0jp 1 IWLabel3: TIWLabel;
31     IWEdit1: TIWEdit;
32     IWButton1: TIWButton;
33 yamat0jp 2 IWEdit2: TIWEdit;
34     IWEdit3: TIWEdit;
35     IWLink2: TIWLink;
36     IWRegion5: TIWRegion;
37     IWLabel7: TIWLabel;
38     IWRegion6: TIWRegion;
39     IWLabel8: TIWLabel;
40     IWList2: TIWList;
41     IWLabel4: TIWLabel;
42 yamat0jp 1 IWRegion7: TIWRegion;
43 yamat0jp 2 IWLabel5: TIWLabel;
44     IWLabel6: TIWLabel;
45 yamat0jp 1 IWList3: TIWList;
46 yamat0jp 5 IWImage1: TIWImage;
47     IWFrame8: TIWFrame8;
48 yamat0jp 7 IWLink4: TIWLink;
49 yamat0jp 5 IWLink3: TIWLink;
50 yamat0jp 8 IWLink5: TIWLink;
51     IWFrame1: TIWFrame1;
52 yamat0jp 1 procedure IWAppFormRender(Sender: TObject);
53 yamat0jp 2 procedure IWLink2Click(Sender: TObject);
54 yamat0jp 1 procedure IWAppFormCreate(Sender: TObject);
55     procedure IWButton1Click(Sender: TObject);
56 yamat0jp 2 procedure IWLink1Click(Sender: TObject);
57 yamat0jp 5 procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
58     procedure IWFrame8IWButton1Click(Sender: TObject);
59     procedure IWFrame8IWLink1Click(Sender: TObject);
60 yamat0jp 7 procedure IWLink4Click(Sender: TObject);
61 yamat0jp 5 procedure IWLink3Click(Sender: TObject);
62 yamat0jp 8 procedure IWLink5Click(Sender: TObject);
63 yamat0jp 1 private
64 yamat0jp 5 Filter: Boolean;
65 yamat0jp 7 function GetPage: Boolean;
66     procedure SetPage(const Value: Boolean);
67 yamat0jp 1 procedure LoadImage;
68     procedure ClearImage;
69 yamat0jp 8 function GetThumbnail: Boolean;
70 yamat0jp 9 procedure CallBack(EventParams: TStringList);
71 yamat0jp 8 procedure SetThumbnail(const Value: Boolean);
72     property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
73 yamat0jp 1 public
74 yamat0jp 7 property Page: Boolean read GetPage write SetPage;
75 yamat0jp 1 end;
76    
77 yamat0jp 8 var
78     IWForm1: TIWForm1;
79    
80 yamat0jp 1 implementation
81    
82     {$R *.dfm}
83    
84 yamat0jp 8 uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10;
85 yamat0jp 1
86 yamat0jp 9 procedure TIWForm1.CallBack(EventParams: TStringList);
87     begin
88     if SameText(EventParams.Values['RetValue'], 'true') = true then
89     TCartForm.Create(WebApplication).Show;
90     end;
91    
92 yamat0jp 2 procedure TIWForm1.ClearImage;
93 yamat0jp 1 var
94 yamat0jp 2 i: Integer;
95     j: Integer;
96 yamat0jp 1 begin
97 yamat0jp 2 for i := 0 to IWGrid1.RowCount - 1 do
98     for j := 0 to IWGrid1.ColumnCount - 1 do
99     IWGrid1.Cell[i, j].Control.Free;
100 yamat0jp 5 IWGrid1.RowCount := 0;
101 yamat0jp 1 end;
102    
103 yamat0jp 7 function TIWForm1.GetPage: Boolean;
104 yamat0jp 1 begin
105     result := UserSession.FPage;
106     end;
107    
108 yamat0jp 8 function TIWForm1.GetThumbnail: Boolean;
109     begin
110     result := UserSession.FThumbnail;
111     end;
112    
113 yamat0jp 2 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
114 yamat0jp 3 const
115     i = 120;
116     var
117     s: Integer;
118 yamat0jp 1 begin
119 yamat0jp 8 IWForm1 := Self;
120 yamat0jp 1 Page := UserSession.FPage;
121 yamat0jp 8 Thumbnail := UserSession.FThumbnail;
122 yamat0jp 3 s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
123     IWLabel2.BGColor := s;
124     IWLabel3.BGColor := s;
125     IWLabel5.BGColor := s;
126 yamat0jp 4 IWLabel7.BGColor := s;
127     IWLabel8.BGColor := s;
128 yamat0jp 3 IWRegion1.Width := i;
129     IWRegion2.Width := i;
130     IWRegion4.Width := i;
131     IWRegion5.Width := i;
132     IWRegion6.Width := i;
133     IWRegion7.Width := i;
134 yamat0jp 9 WebApplication.RegisterCallBack('callback', CallBack);
135 yamat0jp 1 end;
136    
137 yamat0jp 2 procedure TIWForm1.IWAppFormRender(Sender: TObject);
138 yamat0jp 1 var
139     s: string;
140 yamat0jp 2 i, j: Integer;
141 yamat0jp 1 begin
142     IWList1.Items.Clear;
143     with DM.FDTable2 do
144 yamat0jp 2 begin
145 yamat0jp 3 if Filtered = true then
146 yamat0jp 1 begin
147 yamat0jp 3 FindFirst;
148     while Found = true do
149 yamat0jp 1 begin
150 yamat0jp 3 s := FieldByName('CATEGORY').AsString;
151     if s = '' then
152     begin
153     FindNext;
154     continue;
155     end;
156 yamat0jp 2 i := IWList1.Items.IndexOfName(s);
157     if i = -1 then
158     IWList1.Items.Add(s + '=1')
159 yamat0jp 1 else
160     begin
161 yamat0jp 2 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
162     IWList1.Items[i] := s + '=' + j.ToString;
163 yamat0jp 1 end;
164 yamat0jp 3 FindNext;
165     end;
166     end
167     else
168     begin
169     First;
170     while Eof = false do
171 yamat0jp 2 begin
172 yamat0jp 3 s := FieldByName('CATEGORY').AsString;
173     if s = '' then
174     begin
175     Next;
176     continue;
177     end;
178 yamat0jp 2 i := IWList1.Items.IndexOf(s);
179     if i = -1 then
180     IWList1.Items.Add(s);
181 yamat0jp 3 Next;
182 yamat0jp 1 end;
183     end;
184 yamat0jp 2 end;
185 yamat0jp 1 if DM.FDTable2.Filtered = true then
186     for i := 0 to IWList1.Items.Count - 1 do
187     begin
188     s := IWList1.Items.ValueFromIndex[i];
189     if s = '1' then
190     IWList1.Items[i] := IWList1.Items.Names[i]
191     else
192     IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
193     end;
194 yamat0jp 2 IWList2.Items.Clear;
195 yamat0jp 7 if Page = false then
196 yamat0jp 1 begin
197     with DM.FDQuery1 do
198     begin
199     SQL.Clear;
200     SQL.Add('select volume,name,price from cart_data join item_data');
201     SQL.Add(' on (cart_data.serial = item_data.serial)');
202     SQL.Add(' where number = :num;');
203     Params.ParamByName('num').AsInteger := UserSession.user_number;
204     Open;
205 yamat0jp 2 First;
206     i := 0;
207     while Eof = false do
208 yamat0jp 1 begin
209 yamat0jp 2 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
210 yamat0jp 4 i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
211 yamat0jp 2 IWList2.Items.Add(s);
212     Next;
213 yamat0jp 1 end;
214 yamat0jp 2 IWList2.Items.Add(i.ToString + '�~');
215 yamat0jp 1 Close;
216 yamat0jp 2 IWList3.Items.Clear;
217 yamat0jp 1 SQL.Clear;
218     SQL.Add('select name from recent_data join item_data');
219     SQL.Add(' on (recent_data.serial = item_data.serial)');
220     SQL.Add(' where number = :num;');
221 yamat0jp 2 Params.ParamByName('num').AsInteger := UserSession.user_number;
222 yamat0jp 1 Open;
223 yamat0jp 2 First;
224     while Eof = false do
225 yamat0jp 1 begin
226 yamat0jp 2 IWList3.Items.Add(Fields.Fields[0].AsString);
227     Next;
228 yamat0jp 1 end;
229     Close;
230     end;
231     end;
232 yamat0jp 6 LoadImage;
233 yamat0jp 5 if IWGrid1.Visible = true then
234     IWLabel6.Visible := Filter;
235 yamat0jp 1 end;
236    
237 yamat0jp 2 procedure TIWForm1.IWButton1Click(Sender: TObject);
238 yamat0jp 5 var
239     i: Integer;
240 yamat0jp 1 begin
241 yamat0jp 5 IWFrame8IWLink1Click(Sender);
242 yamat0jp 3 if IWEdit1.Text <> '' then
243 yamat0jp 1 begin
244 yamat0jp 4 DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
245 yamat0jp 1 DM.FDTable2.Filtered := true;
246 yamat0jp 5 i := DM.FDTable2.RecordCount;
247     IWLabel6.Caption := Format(IWEdit1.Text + '����������������:%d��', [i]);
248     if i = 0 then
249     DM.FDTable2.Filtered := false;
250     Filter := true;
251     end
252     else
253     begin
254     DM.FDTable2.Filtered := false;
255     Filter := false;
256 yamat0jp 1 end;
257     end;
258    
259 yamat0jp 5 procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
260     var
261     i: Integer;
262     begin
263     if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
264     begin
265     WebApplication.ShowMessage('�������s������');
266     Exit;
267     end;
268     if i = 0 then
269     begin
270     WebApplication.ShowMessage('�P�����������������K�v����');
271     Exit;
272     end;
273     with DM.FDQuery1 do
274     begin
275     SQL.Clear;
276     SQL.Add('select * from cart_data;');
277     Open;
278     if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
279     UserSession.Serial]), []) = true then
280     begin
281     Edit;
282     FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
283     Post;
284     end
285     else
286     AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
287     end;
288     IWFrame8.IWEdit1.Text := '0';
289 yamat0jp 9 WebApplication.ShowConfirm('�J�[�g��������������', 'callback', '����', '����', '������');
290 yamat0jp 5 end;
291    
292     procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
293     begin
294 yamat0jp 8 Thumbnail := true;
295 yamat0jp 5 end;
296    
297     procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
298     const ARow, AColumn: Integer);
299     begin
300 yamat0jp 8 Thumbnail := false;
301 yamat0jp 5 IWFrame8.IWEdit1.Text := '1';
302     UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
303     end;
304    
305 yamat0jp 2 procedure TIWForm1.IWLink1Click(Sender: TObject);
306     begin
307 yamat0jp 8 TUserForm.Create(WebApplication).Show;
308 yamat0jp 2 end;
309    
310     procedure TIWForm1.IWLink2Click(Sender: TObject);
311 yamat0jp 1 begin
312 yamat0jp 7 if Page = true then
313 yamat0jp 8 begin
314     if DM.FDTable1.Locate('EMAIL;PASSWORD',
315     VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true then
316     begin
317     Page := false;
318     UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
319     IWEdit2.Text := '';
320     end;
321     IWEdit3.Text := '';
322     end
323     else
324     begin
325     UserSession.user_number := 0;
326     Page := true;
327     end;
328 yamat0jp 1 end;
329    
330 yamat0jp 5 procedure TIWForm1.IWLink3Click(Sender: TObject);
331     begin
332 yamat0jp 7 with TMyPage.Create(WebApplication) do
333     begin
334     Form := Self;
335     Show;
336     end;
337 yamat0jp 5 end;
338    
339     procedure TIWForm1.IWLink4Click(Sender: TObject);
340     begin
341     TCartForm.Create(WebApplication).Show;
342     end;
343    
344 yamat0jp 8 procedure TIWForm1.IWLink5Click(Sender: TObject);
345     begin
346     TIWForm10.Create(WebApplication).Show;
347     end;
348    
349 yamat0jp 2 procedure TIWForm1.LoadImage;
350 yamat0jp 1 var
351 yamat0jp 2 s: TStream;
352 yamat0jp 1 png: TPngImage;
353 yamat0jp 5 pic: TIWImage;
354 yamat0jp 2 i: Integer;
355     j: Integer;
356 yamat0jp 5 x: Boolean;
357     t: string;
358 yamat0jp 3 label label1;
359 yamat0jp 1 begin
360     ClearImage;
361 yamat0jp 4 png := TPngImage.Create;
362 yamat0jp 2 try
363 yamat0jp 8 if Thumbnail = true then
364 yamat0jp 6 begin
365     i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
366     if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
367     inc(i);
368     IWGrid1.RowCount := i;
369     if DM.FDTable2.Filtered = false then
370     DM.FDTable2.Last
371     else
372     DM.FDTable2.FindLast;
373     for i := 0 to IWGrid1.RowCount - 1 do
374     for j := 0 to IWGrid1.ColumnCount - 1 do
375 yamat0jp 5 begin
376 yamat0jp 6 if DM.FDTable2.Filtered = false then
377     begin
378     if DM.FDTable2.Bof = true then
379     goto label1;
380     end
381     else if DM.FDTable2.Found = false then
382 yamat0jp 5 goto label1;
383 yamat0jp 6 if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
384     begin
385     s := DM.FDTable2.CreateBlobStream
386     (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
387     try
388     png.LoadFromStream(s);
389     finally
390     s.Free;
391     end;
392     pic := TIWImage.Create(IWGrid1);
393     pic.Picture.Assign(png);
394     IWGrid1.Cell[i, j].Control := pic;
395 yamat0jp 5 end;
396 yamat0jp 6 t := DM.FDTable2.FieldByName('NAME').AsString;
397     if Length(t) > 10 then
398     t := Copy(t, 1, 8) + '..';
399     IWGrid1.Cell[i, j].Tag :=
400     Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
401     IWGrid1.Cell[i, j].Text := t;
402     IWGrid1.Cell[i, j].Alignment := taCenter;
403     IWGrid1.Cell[i, j].Clickable := true;
404     if DM.FDTable2.Filtered = false then
405     DM.FDTable2.Prior
406     else
407     DM.FDTable2.FindPrior;
408 yamat0jp 1 end;
409 yamat0jp 6 label1:
410     end
411     else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and
412     (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then
413     begin
414     s := DM.FDTable2.CreateBlobStream
415     (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
416     try
417     png.LoadFromStream(s);
418     IWFrame8.IWImage1.Picture.Assign(png);
419     finally
420     s.Free;
421 yamat0jp 1 end;
422 yamat0jp 6 end
423     else
424     IWFrame8.IWImage1.Picture.Assign(nil);
425 yamat0jp 1 finally
426     png.Free;
427     end;
428 yamat0jp 3 png := nil;
429     s := nil;
430     Randomize;
431 yamat0jp 5 if DM.FDTable2.Filtered = true then
432     begin
433     x := true;
434     DM.FDTable2.Filtered := false;
435     end
436     else
437     x := false;
438 yamat0jp 3 DM.FDTable2.Last;
439 yamat0jp 5 if DM.FDTable2.Bof = true then
440     Exit;
441 yamat0jp 3 DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
442 yamat0jp 5 if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
443 yamat0jp 4 begin
444     s := DM.FDTable2.CreateBlobStream
445     (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
446     png := TPngImage.Create;
447     try
448     png.LoadFromStream(s);
449 yamat0jp 5 IWImage1.Picture.Assign(png);
450 yamat0jp 4 finally
451     png.Free;
452     s.Free;
453     end;
454 yamat0jp 3 end;
455 yamat0jp 5 if x = true then
456     DM.FDTable2.Filtered := true;
457 yamat0jp 3 IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
458 yamat0jp 1 end;
459    
460 yamat0jp 7 procedure TIWForm1.SetPage(const Value: Boolean);
461 yamat0jp 1 begin
462     UserSession.FPage := Value;
463 yamat0jp 7 IWRegion7.Visible := not Value;
464     IWDBLabel1.Visible := not Value;
465     IWLink3.Visible := not Value;
466     IWLink1.Visible := Value;
467     IWText1.Visible := Value;
468     if Value = false then
469 yamat0jp 2 begin
470     IWLabel1.Caption := '��������';
471     IWLink2.Caption := '���O�A�E�g';
472     end
473     else
474     begin
475     IWLabel1.Caption := '���������Q�X�g�l';
476     IWLink2.Caption := '���O�C��';
477 yamat0jp 8 Thumbnail := true;
478     IWText1.Text := '';
479     DM.FDTable2.Filtered := false;
480     Filter := false;
481 yamat0jp 1 end;
482     end;
483    
484 yamat0jp 8 procedure TIWForm1.SetThumbnail(const Value: Boolean);
485     begin
486     UserSession.FThumbnail := Value;
487     IWGrid1.Visible := Value;
488     IWFrame8.Visible := not Value;
489     end;
490    
491 yamat0jp 1 initialization
492    
493 yamat0jp 2 TIWForm1.SetAsMainForm;
494 yamat0jp 1
495     end.

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