Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 8 - (hide 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 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 1 procedure IWAppFormRender(Sender: TObject);
53 yamat0jp 2 procedure IWLink2Click(Sender: TObject);
54 yamat0jp 1 procedure IWAppFormCreate(Sender: TObject);
55     procedure IWButton1Click(Sender: TObject);
56 yamat0jp 2 procedure IWLink1Click(Sender: TObject);
57 yamat0jp 5 procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
58     procedure IWFrame8IWButton1Click(Sender: TObject);
59     procedure IWFrame8IWLink1Click(Sender: TObject);
60 yamat0jp 7 procedure IWLink4Click(Sender: TObject);
61 yamat0jp 5 procedure IWLink3Click(Sender: TObject);
62 yamat0jp 8 procedure IWLink5Click(Sender: TObject);
63 yamat0jp 1 private
64 yamat0jp 5 Filter: Boolean;
65 yamat0jp 7 function GetPage: Boolean;
66     procedure SetPage(const Value: Boolean);
67 yamat0jp 1 procedure LoadImage;
68     procedure ClearImage;
69 yamat0jp 8 function GetThumbnail: Boolean;
70     procedure SetThumbnail(const Value: Boolean);
71     property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
72 yamat0jp 1 public
73 yamat0jp 7 property Page: Boolean read GetPage write SetPage;
74 yamat0jp 1 end;
75    
76 yamat0jp 8 var
77     IWForm1: TIWForm1;
78    
79 yamat0jp 1 implementation
80    
81     {$R *.dfm}
82    
83 yamat0jp 8 uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10;
84 yamat0jp 1
85 yamat0jp 2 procedure TIWForm1.ClearImage;
86 yamat0jp 1 var
87 yamat0jp 2 i: Integer;
88     j: Integer;
89 yamat0jp 1 begin
90 yamat0jp 2 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 yamat0jp 5 IWGrid1.RowCount := 0;
94 yamat0jp 1 end;
95    
96 yamat0jp 7 function TIWForm1.GetPage: Boolean;
97 yamat0jp 1 begin
98     result := UserSession.FPage;
99     end;
100    
101 yamat0jp 8 function TIWForm1.GetThumbnail: Boolean;
102     begin
103     result := UserSession.FThumbnail;
104     end;
105    
106 yamat0jp 2 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
107 yamat0jp 3 const
108     i = 120;
109     var
110     s: Integer;
111 yamat0jp 1 begin
112 yamat0jp 8 IWForm1 := Self;
113 yamat0jp 1 Page := UserSession.FPage;
114 yamat0jp 8 Thumbnail := UserSession.FThumbnail;
115 yamat0jp 3 s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
116     IWLabel2.BGColor := s;
117     IWLabel3.BGColor := s;
118     IWLabel5.BGColor := s;
119 yamat0jp 4 IWLabel7.BGColor := s;
120     IWLabel8.BGColor := s;
121 yamat0jp 3 IWRegion1.Width := i;
122     IWRegion2.Width := i;
123     IWRegion4.Width := i;
124     IWRegion5.Width := i;
125     IWRegion6.Width := i;
126     IWRegion7.Width := i;
127 yamat0jp 1 end;
128    
129 yamat0jp 2 procedure TIWForm1.IWAppFormRender(Sender: TObject);
130 yamat0jp 1 var
131     s: string;
132 yamat0jp 2 i, j: Integer;
133 yamat0jp 1 begin
134     IWList1.Items.Clear;
135     with DM.FDTable2 do
136 yamat0jp 2 begin
137 yamat0jp 3 if Filtered = true then
138 yamat0jp 1 begin
139 yamat0jp 3 FindFirst;
140     while Found = true do
141 yamat0jp 1 begin
142 yamat0jp 3 s := FieldByName('CATEGORY').AsString;
143     if s = '' then
144     begin
145     FindNext;
146     continue;
147     end;
148 yamat0jp 2 i := IWList1.Items.IndexOfName(s);
149     if i = -1 then
150     IWList1.Items.Add(s + '=1')
151 yamat0jp 1 else
152     begin
153 yamat0jp 2 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
154     IWList1.Items[i] := s + '=' + j.ToString;
155 yamat0jp 1 end;
156 yamat0jp 3 FindNext;
157     end;
158     end
159     else
160     begin
161     First;
162     while Eof = false do
163 yamat0jp 2 begin
164 yamat0jp 3 s := FieldByName('CATEGORY').AsString;
165     if s = '' then
166     begin
167     Next;
168     continue;
169     end;
170 yamat0jp 2 i := IWList1.Items.IndexOf(s);
171     if i = -1 then
172     IWList1.Items.Add(s);
173 yamat0jp 3 Next;
174 yamat0jp 1 end;
175     end;
176 yamat0jp 2 end;
177 yamat0jp 1 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 yamat0jp 2 IWList2.Items.Clear;
187 yamat0jp 7 if Page = false then
188 yamat0jp 1 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 yamat0jp 2 First;
198     i := 0;
199     while Eof = false do
200 yamat0jp 1 begin
201 yamat0jp 2 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
202 yamat0jp 4 i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
203 yamat0jp 2 IWList2.Items.Add(s);
204     Next;
205 yamat0jp 1 end;
206 yamat0jp 2 IWList2.Items.Add(i.ToString + '�~');
207 yamat0jp 1 Close;
208 yamat0jp 2 IWList3.Items.Clear;
209 yamat0jp 1 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 yamat0jp 2 Params.ParamByName('num').AsInteger := UserSession.user_number;
214 yamat0jp 1 Open;
215 yamat0jp 2 First;
216     while Eof = false do
217 yamat0jp 1 begin
218 yamat0jp 2 IWList3.Items.Add(Fields.Fields[0].AsString);
219     Next;
220 yamat0jp 1 end;
221     Close;
222     end;
223     end;
224 yamat0jp 6 LoadImage;
225 yamat0jp 5 if IWGrid1.Visible = true then
226     IWLabel6.Visible := Filter;
227 yamat0jp 1 end;
228    
229 yamat0jp 2 procedure TIWForm1.IWButton1Click(Sender: TObject);
230 yamat0jp 5 var
231     i: Integer;
232 yamat0jp 1 begin
233 yamat0jp 5 IWFrame8IWLink1Click(Sender);
234 yamat0jp 3 if IWEdit1.Text <> '' then
235 yamat0jp 1 begin
236 yamat0jp 4 DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
237 yamat0jp 1 DM.FDTable2.Filtered := true;
238 yamat0jp 5 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 yamat0jp 1 end;
249     end;
250    
251 yamat0jp 5 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 yamat0jp 8 Thumbnail := true;
288 yamat0jp 5 end;
289    
290     procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
291     const ARow, AColumn: Integer);
292     begin
293 yamat0jp 8 Thumbnail := false;
294 yamat0jp 5 IWFrame8.IWEdit1.Text := '1';
295     UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
296     end;
297    
298 yamat0jp 2 procedure TIWForm1.IWLink1Click(Sender: TObject);
299     begin
300 yamat0jp 8 TUserForm.Create(WebApplication).Show;
301 yamat0jp 2 end;
302    
303     procedure TIWForm1.IWLink2Click(Sender: TObject);
304 yamat0jp 1 begin
305 yamat0jp 7 if Page = true then
306 yamat0jp 8 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 yamat0jp 1 end;
322    
323 yamat0jp 5 procedure TIWForm1.IWLink3Click(Sender: TObject);
324     begin
325 yamat0jp 7 with TMyPage.Create(WebApplication) do
326     begin
327     Form := Self;
328     Show;
329     end;
330 yamat0jp 5 end;
331    
332     procedure TIWForm1.IWLink4Click(Sender: TObject);
333     begin
334     TCartForm.Create(WebApplication).Show;
335     end;
336    
337 yamat0jp 8 procedure TIWForm1.IWLink5Click(Sender: TObject);
338     begin
339     TIWForm10.Create(WebApplication).Show;
340     end;
341    
342 yamat0jp 2 procedure TIWForm1.LoadImage;
343 yamat0jp 1 var
344 yamat0jp 2 s: TStream;
345 yamat0jp 1 png: TPngImage;
346 yamat0jp 5 pic: TIWImage;
347 yamat0jp 2 i: Integer;
348     j: Integer;
349 yamat0jp 5 x: Boolean;
350     t: string;
351 yamat0jp 3 label label1;
352 yamat0jp 1 begin
353     ClearImage;
354 yamat0jp 4 png := TPngImage.Create;
355 yamat0jp 2 try
356 yamat0jp 8 if Thumbnail = true then
357 yamat0jp 6 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 yamat0jp 5 begin
369 yamat0jp 6 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 yamat0jp 5 goto label1;
376 yamat0jp 6 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 yamat0jp 5 end;
389 yamat0jp 6 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 yamat0jp 1 end;
402 yamat0jp 6 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 yamat0jp 1 end;
415 yamat0jp 6 end
416     else
417     IWFrame8.IWImage1.Picture.Assign(nil);
418 yamat0jp 1 finally
419     png.Free;
420     end;
421 yamat0jp 3 png := nil;
422     s := nil;
423     Randomize;
424 yamat0jp 5 if DM.FDTable2.Filtered = true then
425     begin
426     x := true;
427     DM.FDTable2.Filtered := false;
428     end
429     else
430     x := false;
431 yamat0jp 3 DM.FDTable2.Last;
432 yamat0jp 5 if DM.FDTable2.Bof = true then
433     Exit;
434 yamat0jp 3 DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
435 yamat0jp 5 if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
436 yamat0jp 4 begin
437     s := DM.FDTable2.CreateBlobStream
438     (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
439     png := TPngImage.Create;
440     try
441     png.LoadFromStream(s);
442 yamat0jp 5 IWImage1.Picture.Assign(png);
443 yamat0jp 4 finally
444     png.Free;
445     s.Free;
446     end;
447 yamat0jp 3 end;
448 yamat0jp 5 if x = true then
449     DM.FDTable2.Filtered := true;
450 yamat0jp 3 IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
451 yamat0jp 1 end;
452    
453 yamat0jp 7 procedure TIWForm1.SetPage(const Value: Boolean);
454 yamat0jp 1 begin
455     UserSession.FPage := Value;
456 yamat0jp 7 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 yamat0jp 2 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 yamat0jp 8 Thumbnail := true;
471     IWText1.Text := '';
472     DM.FDTable2.Filtered := false;
473     Filter := false;
474 yamat0jp 1 end;
475     end;
476    
477 yamat0jp 8 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 yamat0jp 1 initialization
485    
486 yamat0jp 2 TIWForm1.SetAsMainForm;
487 yamat0jp 1
488     end.

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