Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

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