Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 18 - (show 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 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 IWLink7: TIWLink;
54 IWLink8: TIWLink;
55 procedure IWAppFormRender(Sender: TObject);
56 procedure IWLink2Click(Sender: TObject);
57 procedure IWAppFormCreate(Sender: TObject);
58 procedure IWButton1Click(Sender: TObject);
59 procedure IWLink1Click(Sender: TObject);
60 procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
61 procedure IWFrame8IWButton1Click(Sender: TObject);
62 procedure IWFrame8IWLink1Click(Sender: TObject);
63 procedure IWLink4Click(Sender: TObject);
64 procedure IWLink3Click(Sender: TObject);
65 procedure IWLink5Click(Sender: TObject);
66 procedure IWLink6Click(Sender: TObject);
67 procedure IWLink8Click(Sender: TObject);
68 private
69 Filter: Boolean;
70 function GetPage: Boolean;
71 procedure SetPage(const Value: Boolean);
72 procedure LoadImage;
73 procedure ClearImage;
74 function GetThumbnail: Boolean;
75 procedure CallBack(EventParams: TStringList);
76 procedure SetThumbnail(const Value: Boolean);
77 public
78 property Page: Boolean read GetPage write SetPage;
79 property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
80 end;
81
82 var
83 IWForm1: TIWForm1;
84
85 implementation
86
87 {$R *.dfm}
88
89 uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5, Unit11,
90 Unit13, Unit14;
91
92 const
93 table2filter = 'AGREE = true and ACTIVATE = true';
94
95 procedure TIWForm1.CallBack(EventParams: TStringList);
96 begin
97 if SameText(EventParams.Values['RetValue'], 'true') = true then
98 TCartForm.Create(WebApplication).Show;
99 IWFrame8.IWEdit1.Text := '0';
100 end;
101
102 procedure TIWForm1.ClearImage;
103 var
104 i: Integer;
105 j: Integer;
106 begin
107 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 IWGrid1.RowCount := 0;
111 end;
112
113 function TIWForm1.GetPage: Boolean;
114 begin
115 result := UserSession.FPage;
116 end;
117
118 function TIWForm1.GetThumbnail: Boolean;
119 begin
120 result := UserSession.FThumbnail;
121 end;
122
123 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
124 const
125 i = 120;
126 var
127 s: Integer;
128 begin
129 IWForm1 := Self;
130 Page := UserSession.FPage;
131 Thumbnail := UserSession.FThumbnail;
132 s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
133 IWLabel2.BGColor := s;
134 IWLabel3.BGColor := s;
135 IWLabel5.BGColor := s;
136 IWLabel7.BGColor := s;
137 IWLabel8.BGColor := s;
138 IWRegion1.Width := i;
139 IWRegion2.Width := i;
140 IWRegion4.Width := i;
141 IWRegion5.Width := i;
142 IWRegion6.Width := i;
143 IWRegion7.Width := i;
144 WebApplication.RegisterCallBack('callback', CallBack);
145 DM.FDTable2.Filter := table2filter;
146 end;
147
148 procedure TIWForm1.IWAppFormRender(Sender: TObject);
149 var
150 s: string;
151 i, j: Integer;
152 begin
153 IWList1.Items.Clear;
154 with DM.FDTable2 do
155 begin
156 FindFirst;
157 while Found = true do
158 begin
159 s := FieldByName('CATEGORY').AsString;
160 if s = '' then
161 begin
162 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 i := IWList1.Items.IndexOfName(s);
174 if i = -1 then
175 IWList1.Items.Add(s + '=1')
176 else
177 begin
178 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
179 IWList1.Items[i] := s + '=' + j.ToString;
180 end;
181 end;
182 FindNext;
183 end;
184 end;
185 if DM.FDTable2.Filter <> table2filter then
186 for i := 0 to IWList1.Items.Count - 1 do
187 begin
188 s := IWList1.Items.ValueFromIndex[i];
189 IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
190 end;
191 IWList2.Items.Clear;
192 with DM.FDQuery1 do
193 begin
194 SQL.Clear;
195 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 Open;
200 First;
201 i := 0;
202 while Eof = false do
203 begin
204 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 end;
209 IWList2.Items.Add(i.ToString + '�~');
210 Close;
211 IWList3.Items.Clear;
212 SQL.Clear;
213 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 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 end;
226 LoadImage;
227 if IWGrid1.Visible = false then
228 DM.FDTable2.Locate('SERIAL', UserSession.Serial);
229 end;
230
231 procedure TIWForm1.IWButton1Click(Sender: TObject);
232 var
233 i: Integer;
234 label searchout;
235 begin
236 IWFrame8IWLink1Click(Sender);
237 if IWEdit1.Text <> '' then
238 begin
239 DM.FDTable2.Filter := table2filter + ' and NAME like ' +
240 QuotedStr('%' + IWEdit1.Text + '%');
241 i := DM.FDTable2.RecordCount;
242 if i = 0 then
243 goto searchout
244 else
245 begin
246 IWLabel6.Caption := Format(IWEdit1.Text + '����������������:%d��', [i]);
247 IWLabel6.Visible := true;
248 end;
249 end
250 else
251 begin
252 searchout:
253 DM.FDTable2.Filter := table2filter;
254 IWLabel6.Visible := false;
255 end;
256 end;
257
258 procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
259 var
260 i, j: Integer;
261 s: string;
262 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 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 DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil, nil,
282 UserSession.user_number, Date]);
283 WebApplication.Response.Cookies.AddCookie('user_cookie',
284 UserSession.user_number.ToString, '/', Date + 10);
285 end;
286 with DM.FDQuery1 do
287 begin
288 Open('select * from cart_data;');
289 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 WebApplication.ShowConfirm('�J�[�g��������������', 'callback', '����', '����', '������');
300 end;
301
302 procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
303 begin
304 Thumbnail := true;
305 end;
306
307 procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
308 const ARow, AColumn: Integer);
309 begin
310 Thumbnail := false;
311 UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
312 end;
313
314 procedure TIWForm1.IWLink1Click(Sender: TObject);
315 begin
316 TUserForm.Create(WebApplication).Show;
317 end;
318
319 procedure TIWForm1.IWLink2Click(Sender: TObject);
320 var
321 i: Integer;
322 begin
323 if Page = true then
324 begin
325 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 begin
331 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 Open('select * from user_data where number = :num', [i]);
338 Delete;
339 Open('select number from cart_data where number = :num;', [i]);
340 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 Page := false;
350 end;
351 IWEdit3.Text := '';
352 end
353 else
354 Page := true;
355 end;
356
357 procedure TIWForm1.IWLink3Click(Sender: TObject);
358 begin
359 with TMyPage.Create(WebApplication) do
360 begin
361 Form := Self;
362 Show;
363 end;
364 end;
365
366 procedure TIWForm1.IWLink4Click(Sender: TObject);
367 begin
368 TCartForm.Create(WebApplication).Show;
369 end;
370
371 procedure TIWForm1.IWLink5Click(Sender: TObject);
372 begin
373 TIWForm10.Create(WebApplication).Show;
374 end;
375
376 procedure TIWForm1.IWLink6Click(Sender: TObject);
377 begin
378 Page := true;
379 if Sender = IWLink6 then
380 TAdminPage.Create(WebApplication).Show
381 else
382 TAdminFile.Create(WebApplication).Show;
383 end;
384
385 procedure TIWForm1.IWLink8Click(Sender: TObject);
386 begin
387 TMasterForm.Create(WebApplication).Show;
388 end;
389
390 procedure TIWForm1.LoadImage;
391 var
392 pic: TIWImage;
393 i: Integer;
394 j: Integer;
395 t: string;
396 label label1;
397 begin
398 ClearImage;
399 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 DM.FDTable2.FindLast;
406 for i := 0 to IWGrid1.RowCount - 1 do
407 for j := 0 to IWGrid1.ColumnCount - 1 do
408 begin
409 if DM.FDTable2.Found = false then
410 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 DM.FDTable2.FindPrior;
424 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 Randomize;
431 DM.FDTableView.Filter := 'DATE > ' + QuotedStr(DateTimeToStr(Date - 10));
432 DM.FDTableView.First;
433 DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
434 UserSession.FieldToImg(IWImage1.Picture,
435 DM.FDTableView.FieldByName('THUMBNAIL'));
436 IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
437 end;
438
439 procedure TIWForm1.SetPage(const Value: Boolean);
440 begin
441 UserSession.FPage := Value;
442 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 begin
449 IWLabel1.Caption := '��������';
450 IWLink2.Caption := '���O�A�E�g';
451 WebApplication.Response.Cookies.AddCookie('user_cookie',
452 UserSession.user_number.ToString, '/', Date + 10);
453 end
454 else
455 begin
456 IWLabel1.Caption := '���������Q�X�g�l';
457 IWLink2.Caption := '���O�C��';
458 Thumbnail := true;
459 IWText1.Text := '';
460 DM.FDTable2.Filtered := false;
461 Filter := false;
462 if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
463 begin
464 WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
465 Date - 1);
466 UserSession.user_number := 0;
467 end;
468 end;
469 end;
470
471 procedure TIWForm1.SetThumbnail(const Value: Boolean);
472 begin
473 UserSession.FThumbnail := Value;
474 IWGrid1.Visible := Value;
475 IWFrame8.IWEdit1.Text := '1';
476 IWFrame8.Visible := not Value;
477 end;
478
479 initialization
480
481 TIWForm1.SetAsMainForm;
482
483 end.

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