Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

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