Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 18 - (hide annotations) (download) (as text)
Sat Aug 27 11:00:30 2016 UTC (7 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 13452 byte(s)
データの更新をメンテナンス中に限定した
コミットファイルの設定を見直し

問題点はRecordCountを使った検索件数表示
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 5 Filter: Boolean;
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     if DM.FDTable2.Filter = table2filter then
166     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 1 for i := 0 to IWList1.Items.Count - 1 do
187     begin
188     s := IWList1.Items.ValueFromIndex[i];
189 yamat0jp 18 IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
190 yamat0jp 1 end;
191 yamat0jp 2 IWList2.Items.Clear;
192 yamat0jp 11 with DM.FDQuery1 do
193 yamat0jp 1 begin
194 yamat0jp 11 SQL.Clear;
195 yamat0jp 15 SQL.Add('select volume,name,price from cart_data,item_data');
196     SQL.Add(' where cart_data.serial = item_data.serial');
197     SQL.Add(' and number = :num;');
198     ParamByName('num').AsInteger := UserSession.user_number;
199 yamat0jp 11 Open;
200     First;
201     i := 0;
202     while Eof = false do
203 yamat0jp 1 begin
204 yamat0jp 11 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
205     i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
206     IWList2.Items.Add(s);
207     Next;
208 yamat0jp 1 end;
209 yamat0jp 11 IWList2.Items.Add(i.ToString + '�~');
210     Close;
211     IWList3.Items.Clear;
212     SQL.Clear;
213 yamat0jp 15 SQL.Add('select name from recent_data,item_data');
214     SQL.Add(' where recent_data.serial = item_data.serial');
215     SQL.Add(' and number = :num;');
216     ParamByName('num').AsInteger := UserSession.user_number;
217 yamat0jp 11 Open;
218     First;
219     while Eof = false do
220     begin
221     IWList3.Items.Add(Fields.Fields[0].AsString);
222     Next;
223     end;
224     Close;
225 yamat0jp 1 end;
226 yamat0jp 6 LoadImage;
227 yamat0jp 18 if IWGrid1.Visible = false then
228 yamat0jp 16 DM.FDTable2.Locate('SERIAL', UserSession.Serial);
229 yamat0jp 1 end;
230    
231 yamat0jp 2 procedure TIWForm1.IWButton1Click(Sender: TObject);
232 yamat0jp 5 var
233     i: Integer;
234 yamat0jp 18 label searchout;
235 yamat0jp 1 begin
236 yamat0jp 5 IWFrame8IWLink1Click(Sender);
237 yamat0jp 3 if IWEdit1.Text <> '' then
238 yamat0jp 1 begin
239 yamat0jp 18 DM.FDTable2.Filter := table2filter + ' and NAME like ' +
240     QuotedStr('%' + IWEdit1.Text + '%');
241 yamat0jp 5 i := DM.FDTable2.RecordCount;
242     if i = 0 then
243 yamat0jp 18 goto searchout
244     else
245     begin
246     IWLabel6.Caption := Format(IWEdit1.Text + '����������������:%d��', [i]);
247     IWLabel6.Visible := true;
248     end;
249 yamat0jp 5 end
250     else
251     begin
252 yamat0jp 18 searchout:
253     DM.FDTable2.Filter := table2filter;
254     IWLabel6.Visible := false;
255 yamat0jp 1 end;
256     end;
257    
258 yamat0jp 5 procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
259     var
260 yamat0jp 11 i, j: Integer;
261     s: string;
262 yamat0jp 5 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 yamat0jp 11 s := WebApplication.Request.CookieFields.Values['user_cookie'];
274     if s = '' then
275     begin
276     DM.FDTable1.Last;
277     j := DM.FDTable1.FieldByName('NUMBER').AsInteger + 1;
278     while DM.FDTable1.Lookup('NUMBER', j, 'NUMBER') = j do
279     inc(j);
280     UserSession.user_number := j;
281 yamat0jp 12 DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil, nil,
282 yamat0jp 11 UserSession.user_number, Date]);
283     WebApplication.Response.Cookies.AddCookie('user_cookie',
284     UserSession.user_number.ToString, '/', Date + 10);
285     end;
286 yamat0jp 5 with DM.FDQuery1 do
287     begin
288 yamat0jp 12 Open('select * from cart_data;');
289 yamat0jp 5 if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
290     UserSession.Serial]), []) = true then
291     begin
292     Edit;
293     FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
294     Post;
295     end
296     else
297     AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
298     end;
299 yamat0jp 9 WebApplication.ShowConfirm('�J�[�g��������������', 'callback', '����', '����', '������');
300 yamat0jp 5 end;
301    
302     procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
303     begin
304 yamat0jp 8 Thumbnail := true;
305 yamat0jp 5 end;
306    
307     procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
308     const ARow, AColumn: Integer);
309     begin
310 yamat0jp 8 Thumbnail := false;
311 yamat0jp 5 UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
312     end;
313    
314 yamat0jp 2 procedure TIWForm1.IWLink1Click(Sender: TObject);
315     begin
316 yamat0jp 8 TUserForm.Create(WebApplication).Show;
317 yamat0jp 2 end;
318    
319     procedure TIWForm1.IWLink2Click(Sender: TObject);
320 yamat0jp 11 var
321     i: Integer;
322 yamat0jp 1 begin
323 yamat0jp 7 if Page = true then
324 yamat0jp 8 begin
325 yamat0jp 11 i := UserSession.user_number;
326     if (DM.FDTable1.Locate('EMAIL;PASSWORD',
327     VarArrayOf([IWEdit2.Text, UserSession.hash(IWEdit3.Text)]),
328     [loCaseInsensitive]) = true) and
329     (DM.FDTable1.FieldByName('EMAIL').AsString <> '') then
330 yamat0jp 8 begin
331 yamat0jp 11 IWEdit2.Text := '';
332     UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
333     if i <> 0 then
334     begin
335     with DM.FDQuery1 do
336     begin
337 yamat0jp 15 Open('select * from user_data where number = :num', [i]);
338 yamat0jp 11 Delete;
339 yamat0jp 15 Open('select number from cart_data where number = :num;', [i]);
340 yamat0jp 11 First;
341     while Eof = false do
342     begin
343     Edit;
344     FieldByName('number').AsInteger := UserSession.user_number;
345     Next;
346     end;
347     end;
348     end;
349 yamat0jp 8 Page := false;
350     end;
351     IWEdit3.Text := '';
352     end
353     else
354     Page := true;
355 yamat0jp 1 end;
356    
357 yamat0jp 5 procedure TIWForm1.IWLink3Click(Sender: TObject);
358     begin
359 yamat0jp 7 with TMyPage.Create(WebApplication) do
360     begin
361     Form := Self;
362     Show;
363     end;
364 yamat0jp 5 end;
365    
366     procedure TIWForm1.IWLink4Click(Sender: TObject);
367     begin
368     TCartForm.Create(WebApplication).Show;
369     end;
370    
371 yamat0jp 8 procedure TIWForm1.IWLink5Click(Sender: TObject);
372     begin
373     TIWForm10.Create(WebApplication).Show;
374     end;
375    
376 yamat0jp 10 procedure TIWForm1.IWLink6Click(Sender: TObject);
377     begin
378 yamat0jp 11 Page := true;
379 yamat0jp 15 if Sender = IWLink6 then
380     TAdminPage.Create(WebApplication).Show
381     else
382     TAdminFile.Create(WebApplication).Show;
383 yamat0jp 10 end;
384    
385 yamat0jp 18 procedure TIWForm1.IWLink8Click(Sender: TObject);
386     begin
387     TMasterForm.Create(WebApplication).Show;
388     end;
389    
390 yamat0jp 2 procedure TIWForm1.LoadImage;
391 yamat0jp 1 var
392 yamat0jp 5 pic: TIWImage;
393 yamat0jp 2 i: Integer;
394     j: Integer;
395 yamat0jp 5 t: string;
396 yamat0jp 3 label label1;
397 yamat0jp 1 begin
398     ClearImage;
399 yamat0jp 16 if Thumbnail = true then
400     begin
401     i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
402     if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
403     inc(i);
404     IWGrid1.RowCount := i;
405 yamat0jp 18 DM.FDTable2.FindLast;
406 yamat0jp 16 for i := 0 to IWGrid1.RowCount - 1 do
407     for j := 0 to IWGrid1.ColumnCount - 1 do
408     begin
409 yamat0jp 18 if DM.FDTable2.Found = false then
410 yamat0jp 16 goto label1;
411     pic := TIWImage.Create(IWGrid1);
412     UserSession.FieldToImg(pic.Picture,
413     DM.FDTable2.FieldByName('THUMBNAIL'));
414     IWGrid1.Cell[i, j].Control := pic;
415     t := DM.FDTable2.FieldByName('NAME').AsString;
416     if Length(t) > 10 then
417     t := Copy(t, 1, 8) + '..';
418     IWGrid1.Cell[i, j].Tag :=
419     Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
420     IWGrid1.Cell[i, j].Text := t;
421     IWGrid1.Cell[i, j].Alignment := taCenter;
422     IWGrid1.Cell[i, j].Clickable := true;
423 yamat0jp 18 DM.FDTable2.FindPrior;
424 yamat0jp 16 end;
425     label1:
426     end
427     else if DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true then
428     UserSession.FieldToImg(IWFrame8.IWImage1.Picture,
429     DM.FDTable2.FieldByName('IMAGE'));
430 yamat0jp 3 Randomize;
431 yamat0jp 16 DM.FDTableView.Filter := 'DATE > ' + QuotedStr(DateTimeToStr(Date - 10));
432 yamat0jp 15 DM.FDTableView.First;
433     DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
434 yamat0jp 16 UserSession.FieldToImg(IWImage1.Picture,
435     DM.FDTableView.FieldByName('THUMBNAIL'));
436 yamat0jp 15 IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
437 yamat0jp 1 end;
438    
439 yamat0jp 7 procedure TIWForm1.SetPage(const Value: Boolean);
440 yamat0jp 1 begin
441     UserSession.FPage := Value;
442 yamat0jp 7 IWRegion7.Visible := not Value;
443     IWDBLabel1.Visible := not Value;
444     IWLink3.Visible := not Value;
445     IWLink1.Visible := Value;
446     IWText1.Visible := Value;
447     if Value = false then
448 yamat0jp 2 begin
449     IWLabel1.Caption := '��������';
450     IWLink2.Caption := '���O�A�E�g';
451 yamat0jp 11 WebApplication.Response.Cookies.AddCookie('user_cookie',
452     UserSession.user_number.ToString, '/', Date + 10);
453 yamat0jp 2 end
454     else
455     begin
456     IWLabel1.Caption := '���������Q�X�g�l';
457     IWLink2.Caption := '���O�C��';
458 yamat0jp 8 Thumbnail := true;
459     IWText1.Text := '';
460     DM.FDTable2.Filtered := false;
461     Filter := false;
462 yamat0jp 11 if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
463     begin
464 yamat0jp 15 WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
465     Date - 1);
466 yamat0jp 11 UserSession.user_number := 0;
467     end;
468 yamat0jp 1 end;
469     end;
470    
471 yamat0jp 8 procedure TIWForm1.SetThumbnail(const Value: Boolean);
472     begin
473     UserSession.FThumbnail := Value;
474     IWGrid1.Visible := Value;
475 yamat0jp 17 IWFrame8.IWEdit1.Text := '1';
476 yamat0jp 8 IWFrame8.Visible := not Value;
477     end;
478    
479 yamat0jp 1 initialization
480    
481 yamat0jp 2 TIWForm1.SetAsMainForm;
482 yamat0jp 1
483     end.

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