Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

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