Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 12 - (show 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 unit Unit1;
2
3 interface
4
5 uses
6 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 IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
11 IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12 IWHTMLControls, IWCompExtCtrls, PngImage, Data.DB,
13 IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14 IWCompMenu, Vcl.Menus, System.Variants, Vcl.Dialogs, System.UITypes, Unit8;
15
16 type
17 TIWForm1 = class(TIWAppForm)
18 IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
19 IWLabel1: TIWLabel;
20 IWDBLabel1: TIWDBLabel;
21 IWRegion1: TIWRegion;
22 IWRegion2: TIWRegion;
23 IWText1: TIWText;
24 IWGrid1: TIWGrid;
25 IWRegion3: TIWRegion;
26 IWRegion4: TIWRegion;
27 IWLink1: TIWLink;
28 IWLabel2: TIWLabel;
29 IWList1: TIWList;
30 IWLabel3: TIWLabel;
31 IWEdit1: TIWEdit;
32 IWButton1: TIWButton;
33 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 IWRegion7: TIWRegion;
43 IWLabel5: TIWLabel;
44 IWLabel6: TIWLabel;
45 IWList3: TIWList;
46 IWImage1: TIWImage;
47 IWFrame8: TIWFrame8;
48 IWLink4: TIWLink;
49 IWLink3: TIWLink;
50 IWLink5: TIWLink;
51 IWFrame1: TIWFrame1;
52 IWLink6: TIWLink;
53 procedure IWAppFormRender(Sender: TObject);
54 procedure IWLink2Click(Sender: TObject);
55 procedure IWAppFormCreate(Sender: TObject);
56 procedure IWButton1Click(Sender: TObject);
57 procedure IWLink1Click(Sender: TObject);
58 procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
59 procedure IWFrame8IWButton1Click(Sender: TObject);
60 procedure IWFrame8IWLink1Click(Sender: TObject);
61 procedure IWLink4Click(Sender: TObject);
62 procedure IWLink3Click(Sender: TObject);
63 procedure IWLink5Click(Sender: TObject);
64 procedure IWLink6Click(Sender: TObject);
65 private
66 Filter: Boolean;
67 function GetPage: Boolean;
68 procedure SetPage(const Value: Boolean);
69 procedure LoadImage;
70 procedure ClearImage;
71 function GetThumbnail: Boolean;
72 procedure CallBack(EventParams: TStringList);
73 procedure SetThumbnail(const Value: Boolean);
74 public
75 property Page: Boolean read GetPage write SetPage;
76 property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
77 end;
78
79 var
80 IWForm1: TIWForm1;
81
82 implementation
83
84 {$R *.dfm}
85
86 uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5;
87
88 procedure TIWForm1.CallBack(EventParams: TStringList);
89 begin
90 if SameText(EventParams.Values['RetValue'], 'true') = true then
91 TCartForm.Create(WebApplication).Show;
92 IWFrame8.IWEdit1.Text := '0';
93 end;
94
95 procedure TIWForm1.ClearImage;
96 var
97 i: Integer;
98 j: Integer;
99 begin
100 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 IWGrid1.RowCount := 0;
104 end;
105
106 function TIWForm1.GetPage: Boolean;
107 begin
108 result := UserSession.FPage;
109 end;
110
111 function TIWForm1.GetThumbnail: Boolean;
112 begin
113 result := UserSession.FThumbnail;
114 end;
115
116 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
117 const
118 i = 120;
119 var
120 s: Integer;
121 begin
122 IWForm1 := Self;
123 Page := UserSession.FPage;
124 Thumbnail := UserSession.FThumbnail;
125 s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
126 IWLabel2.BGColor := s;
127 IWLabel3.BGColor := s;
128 IWLabel5.BGColor := s;
129 IWLabel7.BGColor := s;
130 IWLabel8.BGColor := s;
131 IWRegion1.Width := i;
132 IWRegion2.Width := i;
133 IWRegion4.Width := i;
134 IWRegion5.Width := i;
135 IWRegion6.Width := i;
136 IWRegion7.Width := i;
137 WebApplication.RegisterCallBack('callback', CallBack);
138 end;
139
140 procedure TIWForm1.IWAppFormRender(Sender: TObject);
141 var
142 s: string;
143 i, j: Integer;
144 begin
145 IWList1.Items.Clear;
146 with DM.FDTable2 do
147 begin
148 if Filtered = true then
149 begin
150 FindFirst;
151 while Found = true do
152 begin
153 s := FieldByName('CATEGORY').AsString;
154 if s = '' then
155 begin
156 FindNext;
157 continue;
158 end;
159 i := IWList1.Items.IndexOfName(s);
160 if i = -1 then
161 IWList1.Items.Add(s + '=1')
162 else
163 begin
164 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
165 IWList1.Items[i] := s + '=' + j.ToString;
166 end;
167 FindNext;
168 end;
169 end
170 else
171 begin
172 First;
173 while Eof = false do
174 begin
175 s := FieldByName('CATEGORY').AsString;
176 if s = '' then
177 begin
178 Next;
179 continue;
180 end;
181 i := IWList1.Items.IndexOf(s);
182 if i = -1 then
183 IWList1.Items.Add(s);
184 Next;
185 end;
186 end;
187 end;
188 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 IWList2.Items.Clear;
198 with DM.FDQuery1 do
199 begin
200 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 begin
210 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 end;
215 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 end;
232 LoadImage;
233 if IWGrid1.Visible = true then
234 IWLabel6.Visible := Filter;
235 end;
236
237 procedure TIWForm1.IWButton1Click(Sender: TObject);
238 var
239 i: Integer;
240 begin
241 IWFrame8IWLink1Click(Sender);
242 if IWEdit1.Text <> '' then
243 begin
244 DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
245 DM.FDTable2.Filtered := true;
246 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 end;
257 end;
258
259 procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
260 var
261 i, j: Integer;
262 s: string;
263 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 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 DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil, nil,
283 UserSession.user_number, Date]);
284 WebApplication.Response.Cookies.AddCookie('user_cookie',
285 UserSession.user_number.ToString, '/', Date + 10);
286 end;
287 with DM.FDQuery1 do
288 begin
289 Open('select * from cart_data;');
290 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 WebApplication.ShowConfirm('�J�[�g��������������', 'callback', '����', '����', '������');
301 end;
302
303 procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
304 begin
305 Thumbnail := true;
306 end;
307
308 procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
309 const ARow, AColumn: Integer);
310 begin
311 Thumbnail := false;
312 IWFrame8.IWEdit1.Text := '1';
313 UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
314 end;
315
316 procedure TIWForm1.IWLink1Click(Sender: TObject);
317 begin
318 TUserForm.Create(WebApplication).Show;
319 end;
320
321 procedure TIWForm1.IWLink2Click(Sender: TObject);
322 var
323 i: Integer;
324 begin
325 if Page = true then
326 begin
327 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 begin
333 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 Open('select * from user_data where number = :num',[i]);
340 Delete;
341 Open('select number from cart_data where number = :num;',[i]);
342 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 Page := false;
352 end;
353 IWEdit3.Text := '';
354 end
355 else
356 Page := true;
357 end;
358
359 procedure TIWForm1.IWLink3Click(Sender: TObject);
360 begin
361 with TMyPage.Create(WebApplication) do
362 begin
363 Form := Self;
364 Show;
365 end;
366 end;
367
368 procedure TIWForm1.IWLink4Click(Sender: TObject);
369 begin
370 TCartForm.Create(WebApplication).Show;
371 end;
372
373 procedure TIWForm1.IWLink5Click(Sender: TObject);
374 begin
375 TIWForm10.Create(WebApplication).Show;
376 end;
377
378 procedure TIWForm1.IWLink6Click(Sender: TObject);
379 begin
380 Page := true;
381 TAdminPage.Create(WebApplication).Show;
382 end;
383
384 procedure TIWForm1.LoadImage;
385 var
386 s: TStream;
387 png: TPngImage;
388 pic: TIWImage;
389 i: Integer;
390 j: Integer;
391 x: Boolean;
392 t: string;
393 label label1;
394 begin
395 ClearImage;
396 png := TPngImage.Create;
397 try
398 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 begin
413 if DM.FDTable2.Bof = true then
414 goto label1;
415 end
416 else if DM.FDTable2.Found = false then
417 goto label1;
418 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 end;
431 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 end;
444 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 end;
457 end
458 else
459 IWFrame8.IWImage1.Picture.Assign(nil);
460 finally
461 png.Free;
462 end;
463 png := nil;
464 s := nil;
465 Randomize;
466 if DM.FDTable2.Filtered = true then
467 begin
468 x := true;
469 DM.FDTable2.Filtered := false;
470 end
471 else
472 x := false;
473 DM.FDTable2.Last;
474 if DM.FDTable2.Bof = true then
475 Exit;
476 DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
477 if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
478 begin
479 s := DM.FDTable2.CreateBlobStream
480 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
481 png := TPngImage.Create;
482 try
483 png.LoadFromStream(s);
484 IWImage1.Picture.Assign(png);
485 finally
486 png.Free;
487 s.Free;
488 end;
489 end;
490 if x = true then
491 DM.FDTable2.Filtered := true;
492 IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
493 end;
494
495 procedure TIWForm1.SetPage(const Value: Boolean);
496 begin
497 UserSession.FPage := Value;
498 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 begin
505 IWLabel1.Caption := '��������';
506 IWLink2.Caption := '���O�A�E�g';
507 WebApplication.Response.Cookies.AddCookie('user_cookie',
508 UserSession.user_number.ToString, '/', Date + 10);
509 end
510 else
511 begin
512 IWLabel1.Caption := '���������Q�X�g�l';
513 IWLink2.Caption := '���O�C��';
514 Thumbnail := true;
515 IWText1.Text := '';
516 DM.FDTable2.Filtered := false;
517 Filter := false;
518 if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
519 begin
520 WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/', Date - 1);
521 UserSession.user_number := 0;
522 end;
523 end;
524 end;
525
526 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 initialization
534
535 TIWForm1.SetAsMainForm;
536
537 end.

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