Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (hide annotations) (download) (as text)
Sat Jan 16 23:06:35 2016 UTC (8 years, 2 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 13453 byte(s)
配送用納品書ページ作成

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

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