Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

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