Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 20 - (hide annotations) (download) (as text)
Sat Aug 27 21:03:47 2016 UTC (7 years, 7 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 14106 byte(s)
検索機能強化
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 10 IWLink6: TIWLink;
53 yamat0jp 15 IWLink7: TIWLink;
54 yamat0jp 18 IWLink8: TIWLink;
55 yamat0jp 1 procedure IWAppFormRender(Sender: TObject);
56 yamat0jp 2 procedure IWLink2Click(Sender: TObject);
57 yamat0jp 1 procedure IWAppFormCreate(Sender: TObject);
58     procedure IWButton1Click(Sender: TObject);
59 yamat0jp 2 procedure IWLink1Click(Sender: TObject);
60 yamat0jp 5 procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
61     procedure IWFrame8IWButton1Click(Sender: TObject);
62     procedure IWFrame8IWLink1Click(Sender: TObject);
63 yamat0jp 7 procedure IWLink4Click(Sender: TObject);
64 yamat0jp 5 procedure IWLink3Click(Sender: TObject);
65 yamat0jp 8 procedure IWLink5Click(Sender: TObject);
66 yamat0jp 10 procedure IWLink6Click(Sender: TObject);
67 yamat0jp 18 procedure IWLink8Click(Sender: TObject);
68 yamat0jp 1 private
69 yamat0jp 20 function SearchCount: Integer;
70 yamat0jp 7 function GetPage: Boolean;
71     procedure SetPage(const Value: Boolean);
72 yamat0jp 1 procedure LoadImage;
73     procedure ClearImage;
74 yamat0jp 8 function GetThumbnail: Boolean;
75 yamat0jp 9 procedure CallBack(EventParams: TStringList);
76 yamat0jp 8 procedure SetThumbnail(const Value: Boolean);
77 yamat0jp 1 public
78 yamat0jp 7 property Page: Boolean read GetPage write SetPage;
79 yamat0jp 10 property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
80 yamat0jp 1 end;
81    
82 yamat0jp 8 var
83     IWForm1: TIWForm1;
84    
85 yamat0jp 1 implementation
86    
87     {$R *.dfm}
88    
89 yamat0jp 18 uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5, Unit11,
90     Unit13, Unit14;
91 yamat0jp 1
92 yamat0jp 18 const
93     table2filter = 'AGREE = true and ACTIVATE = true';
94    
95 yamat0jp 9 procedure TIWForm1.CallBack(EventParams: TStringList);
96     begin
97     if SameText(EventParams.Values['RetValue'], 'true') = true then
98     TCartForm.Create(WebApplication).Show;
99 yamat0jp 11 IWFrame8.IWEdit1.Text := '0';
100 yamat0jp 9 end;
101    
102 yamat0jp 2 procedure TIWForm1.ClearImage;
103 yamat0jp 1 var
104 yamat0jp 2 i: Integer;
105     j: Integer;
106 yamat0jp 1 begin
107 yamat0jp 2 for i := 0 to IWGrid1.RowCount - 1 do
108     for j := 0 to IWGrid1.ColumnCount - 1 do
109     IWGrid1.Cell[i, j].Control.Free;
110 yamat0jp 5 IWGrid1.RowCount := 0;
111 yamat0jp 1 end;
112    
113 yamat0jp 7 function TIWForm1.GetPage: Boolean;
114 yamat0jp 1 begin
115     result := UserSession.FPage;
116     end;
117    
118 yamat0jp 8 function TIWForm1.GetThumbnail: Boolean;
119     begin
120     result := UserSession.FThumbnail;
121     end;
122    
123 yamat0jp 2 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
124 yamat0jp 3 const
125     i = 120;
126     var
127     s: Integer;
128 yamat0jp 1 begin
129 yamat0jp 8 IWForm1 := Self;
130 yamat0jp 1 Page := UserSession.FPage;
131 yamat0jp 8 Thumbnail := UserSession.FThumbnail;
132 yamat0jp 3 s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
133     IWLabel2.BGColor := s;
134     IWLabel3.BGColor := s;
135     IWLabel5.BGColor := s;
136 yamat0jp 4 IWLabel7.BGColor := s;
137     IWLabel8.BGColor := s;
138 yamat0jp 3 IWRegion1.Width := i;
139     IWRegion2.Width := i;
140     IWRegion4.Width := i;
141     IWRegion5.Width := i;
142     IWRegion6.Width := i;
143     IWRegion7.Width := i;
144 yamat0jp 9 WebApplication.RegisterCallBack('callback', CallBack);
145 yamat0jp 18 DM.FDTable2.Filter := table2filter;
146 yamat0jp 1 end;
147    
148 yamat0jp 2 procedure TIWForm1.IWAppFormRender(Sender: TObject);
149 yamat0jp 1 var
150     s: string;
151 yamat0jp 2 i, j: Integer;
152 yamat0jp 1 begin
153     IWList1.Items.Clear;
154     with DM.FDTable2 do
155 yamat0jp 2 begin
156 yamat0jp 18 FindFirst;
157     while Found = true do
158 yamat0jp 1 begin
159 yamat0jp 18 s := FieldByName('CATEGORY').AsString;
160     if s = '' then
161 yamat0jp 1 begin
162 yamat0jp 18 FindNext;
163     continue;
164     end;
165 yamat0jp 20 if Filter = table2filter then
166 yamat0jp 18 begin
167     i := IWList1.Items.IndexOf(s);
168     if i = -1 then
169     IWList1.Items.Add(s);
170     end
171     else
172     begin
173 yamat0jp 2 i := IWList1.Items.IndexOfName(s);
174     if i = -1 then
175     IWList1.Items.Add(s + '=1')
176 yamat0jp 1 else
177     begin
178 yamat0jp 2 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
179     IWList1.Items[i] := s + '=' + j.ToString;
180 yamat0jp 1 end;
181 yamat0jp 3 end;
182 yamat0jp 18 FindNext;
183 yamat0jp 1 end;
184 yamat0jp 2 end;
185 yamat0jp 18 if DM.FDTable2.Filter <> table2filter then
186 yamat0jp 20 begin
187 yamat0jp 1 for i := 0 to IWList1.Items.Count - 1 do
188     begin
189     s := IWList1.Items.ValueFromIndex[i];
190 yamat0jp 18 IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
191 yamat0jp 1 end;
192 yamat0jp 20 end;
193 yamat0jp 2 IWList2.Items.Clear;
194 yamat0jp 11 with DM.FDQuery1 do
195 yamat0jp 1 begin
196 yamat0jp 11 SQL.Clear;
197 yamat0jp 15 SQL.Add('select volume,name,price from cart_data,item_data');
198     SQL.Add(' where cart_data.serial = item_data.serial');
199     SQL.Add(' and number = :num;');
200     ParamByName('num').AsInteger := UserSession.user_number;
201 yamat0jp 11 Open;
202     First;
203     i := 0;
204     while Eof = false do
205 yamat0jp 1 begin
206 yamat0jp 11 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
207     i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
208     IWList2.Items.Add(s);
209     Next;
210 yamat0jp 1 end;
211 yamat0jp 11 IWList2.Items.Add(i.ToString + '�~');
212     Close;
213     IWList3.Items.Clear;
214     SQL.Clear;
215 yamat0jp 15 SQL.Add('select name from recent_data,item_data');
216     SQL.Add(' where recent_data.serial = item_data.serial');
217     SQL.Add(' and number = :num;');
218     ParamByName('num').AsInteger := UserSession.user_number;
219 yamat0jp 11 Open;
220     First;
221     while Eof = false do
222     begin
223     IWList3.Items.Add(Fields.Fields[0].AsString);
224     Next;
225     end;
226     Close;
227 yamat0jp 1 end;
228 yamat0jp 6 LoadImage;
229 yamat0jp 18 if IWGrid1.Visible = false then
230 yamat0jp 16 DM.FDTable2.Locate('SERIAL', UserSession.Serial);
231 yamat0jp 1 end;
232    
233 yamat0jp 2 procedure TIWForm1.IWButton1Click(Sender: TObject);
234 yamat0jp 5 var
235 yamat0jp 20 s: TStringList;
236     t: string;
237 yamat0jp 5 i: Integer;
238 yamat0jp 1 begin
239 yamat0jp 20 Thumbnail := true;
240 yamat0jp 3 if IWEdit1.Text <> '' then
241 yamat0jp 1 begin
242 yamat0jp 20 s := TStringList.Create;
243     try
244     s.Delimiter := ' ';
245     s.DelimitedText := IWEdit1.Text;
246     for i := 0 to s.Count - 1 do
247     begin
248     t := t + 'NAME like ' + QuotedStr('%' + s[i] + '%');
249     if i < s.Count - 1 then
250     t := t + ' or '
251     else
252     t := '(' + t + ')';
253     end;
254     DM.FDTable2.Filter := table2filter + ' and ' + t;
255     i := SearchCount;
256     if i = 0 then
257     begin
258     DM.FDTable2.Filter := table2filter;
259     IWLabel6.Caption := '�Y���������i����������������������';
260     end
261     else
262     IWLabel6.Caption := Format(IWEdit1.Text + '����������������:%d��', [i]);
263 yamat0jp 18 IWLabel6.Visible := true;
264 yamat0jp 20 finally
265     s.Free;
266 yamat0jp 18 end;
267 yamat0jp 5 end
268     else
269     begin
270 yamat0jp 18 DM.FDTable2.Filter := table2filter;
271     IWLabel6.Visible := false;
272 yamat0jp 1 end;
273     end;
274    
275 yamat0jp 5 procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
276     var
277 yamat0jp 11 i, j: Integer;
278     s: string;
279 yamat0jp 5 begin
280     if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
281     begin
282     WebApplication.ShowMessage('�������s������');
283     Exit;
284     end;
285     if i = 0 then
286     begin
287     WebApplication.ShowMessage('�P�����������������K�v����');
288     Exit;
289     end;
290 yamat0jp 11 s := WebApplication.Request.CookieFields.Values['user_cookie'];
291     if s = '' then
292     begin
293     DM.FDTable1.Last;
294     j := DM.FDTable1.FieldByName('NUMBER').AsInteger + 1;
295     while DM.FDTable1.Lookup('NUMBER', j, 'NUMBER') = j do
296     inc(j);
297     UserSession.user_number := j;
298 yamat0jp 12 DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil, nil,
299 yamat0jp 11 UserSession.user_number, Date]);
300     WebApplication.Response.Cookies.AddCookie('user_cookie',
301     UserSession.user_number.ToString, '/', Date + 10);
302     end;
303 yamat0jp 5 with DM.FDQuery1 do
304     begin
305 yamat0jp 12 Open('select * from cart_data;');
306 yamat0jp 5 if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
307     UserSession.Serial]), []) = true then
308     begin
309     Edit;
310     FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
311     Post;
312     end
313     else
314     AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
315     end;
316 yamat0jp 9 WebApplication.ShowConfirm('�J�[�g��������������', 'callback', '����', '����', '������');
317 yamat0jp 5 end;
318    
319     procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
320     begin
321 yamat0jp 8 Thumbnail := true;
322 yamat0jp 5 end;
323    
324     procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
325     const ARow, AColumn: Integer);
326     begin
327 yamat0jp 8 Thumbnail := false;
328 yamat0jp 5 UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
329     end;
330    
331 yamat0jp 2 procedure TIWForm1.IWLink1Click(Sender: TObject);
332     begin
333 yamat0jp 8 TUserForm.Create(WebApplication).Show;
334 yamat0jp 2 end;
335    
336     procedure TIWForm1.IWLink2Click(Sender: TObject);
337 yamat0jp 11 var
338     i: Integer;
339 yamat0jp 1 begin
340 yamat0jp 7 if Page = true then
341 yamat0jp 8 begin
342 yamat0jp 11 i := UserSession.user_number;
343     if (DM.FDTable1.Locate('EMAIL;PASSWORD',
344     VarArrayOf([IWEdit2.Text, UserSession.hash(IWEdit3.Text)]),
345     [loCaseInsensitive]) = true) and
346     (DM.FDTable1.FieldByName('EMAIL').AsString <> '') then
347 yamat0jp 8 begin
348 yamat0jp 11 IWEdit2.Text := '';
349     UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
350     if i <> 0 then
351     begin
352     with DM.FDQuery1 do
353     begin
354 yamat0jp 15 Open('select * from user_data where number = :num', [i]);
355 yamat0jp 11 Delete;
356 yamat0jp 15 Open('select number from cart_data where number = :num;', [i]);
357 yamat0jp 11 First;
358     while Eof = false do
359     begin
360     Edit;
361     FieldByName('number').AsInteger := UserSession.user_number;
362     Next;
363     end;
364     end;
365     end;
366 yamat0jp 8 Page := false;
367     end;
368     IWEdit3.Text := '';
369     end
370     else
371     Page := true;
372 yamat0jp 1 end;
373    
374 yamat0jp 5 procedure TIWForm1.IWLink3Click(Sender: TObject);
375     begin
376 yamat0jp 7 with TMyPage.Create(WebApplication) do
377     begin
378     Form := Self;
379     Show;
380     end;
381 yamat0jp 5 end;
382    
383     procedure TIWForm1.IWLink4Click(Sender: TObject);
384     begin
385     TCartForm.Create(WebApplication).Show;
386     end;
387    
388 yamat0jp 8 procedure TIWForm1.IWLink5Click(Sender: TObject);
389     begin
390     TIWForm10.Create(WebApplication).Show;
391     end;
392    
393 yamat0jp 10 procedure TIWForm1.IWLink6Click(Sender: TObject);
394     begin
395 yamat0jp 11 Page := true;
396 yamat0jp 15 if Sender = IWLink6 then
397     TAdminPage.Create(WebApplication).Show
398     else
399     TAdminFile.Create(WebApplication).Show;
400 yamat0jp 10 end;
401    
402 yamat0jp 18 procedure TIWForm1.IWLink8Click(Sender: TObject);
403     begin
404     TMasterForm.Create(WebApplication).Show;
405     end;
406    
407 yamat0jp 2 procedure TIWForm1.LoadImage;
408 yamat0jp 1 var
409 yamat0jp 5 pic: TIWImage;
410 yamat0jp 2 i: Integer;
411     j: Integer;
412 yamat0jp 5 t: string;
413 yamat0jp 3 label label1;
414 yamat0jp 1 begin
415     ClearImage;
416 yamat0jp 16 if Thumbnail = true then
417     begin
418     i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
419     if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
420     inc(i);
421     IWGrid1.RowCount := i;
422 yamat0jp 18 DM.FDTable2.FindLast;
423 yamat0jp 16 for i := 0 to IWGrid1.RowCount - 1 do
424     for j := 0 to IWGrid1.ColumnCount - 1 do
425     begin
426 yamat0jp 18 if DM.FDTable2.Found = false then
427 yamat0jp 16 goto label1;
428     pic := TIWImage.Create(IWGrid1);
429     UserSession.FieldToImg(pic.Picture,
430     DM.FDTable2.FieldByName('THUMBNAIL'));
431     IWGrid1.Cell[i, j].Control := pic;
432     t := DM.FDTable2.FieldByName('NAME').AsString;
433     if Length(t) > 10 then
434     t := Copy(t, 1, 8) + '..';
435     IWGrid1.Cell[i, j].Tag :=
436     Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
437     IWGrid1.Cell[i, j].Text := t;
438     IWGrid1.Cell[i, j].Alignment := taCenter;
439     IWGrid1.Cell[i, j].Clickable := true;
440 yamat0jp 18 DM.FDTable2.FindPrior;
441 yamat0jp 16 end;
442     label1:
443     end
444     else if DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true then
445     UserSession.FieldToImg(IWFrame8.IWImage1.Picture,
446     DM.FDTable2.FieldByName('IMAGE'));
447 yamat0jp 3 Randomize;
448 yamat0jp 16 DM.FDTableView.Filter := 'DATE > ' + QuotedStr(DateTimeToStr(Date - 10));
449 yamat0jp 15 DM.FDTableView.First;
450     DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
451 yamat0jp 16 UserSession.FieldToImg(IWImage1.Picture,
452     DM.FDTableView.FieldByName('THUMBNAIL'));
453 yamat0jp 15 IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
454 yamat0jp 1 end;
455    
456 yamat0jp 20 function TIWForm1.SearchCount: Integer;
457     begin
458     with DM.FDTable2 do
459     begin
460     if FindFirst = true then
461     begin
462     result := 1;
463     while FindNext = true do
464     inc(result);
465     end
466     else
467     result := 0;
468     end;
469     end;
470    
471 yamat0jp 7 procedure TIWForm1.SetPage(const Value: Boolean);
472 yamat0jp 1 begin
473     UserSession.FPage := Value;
474 yamat0jp 7 IWRegion7.Visible := not Value;
475     IWDBLabel1.Visible := not Value;
476     IWLink3.Visible := not Value;
477     IWLink1.Visible := Value;
478     IWText1.Visible := Value;
479     if Value = false then
480 yamat0jp 2 begin
481     IWLabel1.Caption := '��������';
482     IWLink2.Caption := '���O�A�E�g';
483 yamat0jp 11 WebApplication.Response.Cookies.AddCookie('user_cookie',
484     UserSession.user_number.ToString, '/', Date + 10);
485 yamat0jp 2 end
486     else
487     begin
488     IWLabel1.Caption := '���������Q�X�g�l';
489     IWLink2.Caption := '���O�C��';
490 yamat0jp 8 Thumbnail := true;
491     IWText1.Text := '';
492 yamat0jp 20 DM.FDTable2.Filter := table2filter;
493 yamat0jp 11 if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
494     begin
495 yamat0jp 15 WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
496     Date - 1);
497 yamat0jp 11 UserSession.user_number := 0;
498     end;
499 yamat0jp 1 end;
500     end;
501    
502 yamat0jp 8 procedure TIWForm1.SetThumbnail(const Value: Boolean);
503     begin
504     UserSession.FThumbnail := Value;
505     IWGrid1.Visible := Value;
506 yamat0jp 17 IWFrame8.IWEdit1.Text := '1';
507 yamat0jp 8 IWFrame8.Visible := not Value;
508     end;
509    
510 yamat0jp 1 initialization
511    
512 yamat0jp 2 TIWForm1.SetAsMainForm;
513 yamat0jp 1
514     end.

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