Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (show 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 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 procedure IWAppFormRender(Sender: TObject);
54 procedure IWLink2Click(Sender: TObject);
55 procedure IWAppFormCreate(Sender: TObject);
56 procedure IWButton1Click(Sender: TObject);
57 procedure IWLink1Click(Sender: TObject);
58 procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
59 procedure IWFrame8IWButton1Click(Sender: TObject);
60 procedure IWFrame8IWLink1Click(Sender: TObject);
61 procedure IWLink4Click(Sender: TObject);
62 procedure IWLink3Click(Sender: TObject);
63 procedure IWLink5Click(Sender: TObject);
64 procedure IWLink6Click(Sender: TObject);
65 private
66 Filter: Boolean;
67 function GetPage: Boolean;
68 procedure SetPage(const Value: Boolean);
69 procedure LoadImage;
70 procedure ClearImage;
71 function GetThumbnail: Boolean;
72 procedure CallBack(EventParams: TStringList);
73 procedure SetThumbnail(const Value: Boolean);
74 public
75 property Page: Boolean read GetPage write SetPage;
76 property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
77 end;
78
79 var
80 IWForm1: TIWForm1;
81
82 implementation
83
84 {$R *.dfm}
85
86 uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5;
87
88 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 procedure TIWForm1.ClearImage;
95 var
96 i: Integer;
97 j: Integer;
98 begin
99 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 IWGrid1.RowCount := 0;
103 end;
104
105 function TIWForm1.GetPage: Boolean;
106 begin
107 result := UserSession.FPage;
108 end;
109
110 function TIWForm1.GetThumbnail: Boolean;
111 begin
112 result := UserSession.FThumbnail;
113 end;
114
115 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
116 const
117 i = 120;
118 var
119 s: Integer;
120 begin
121 IWForm1 := Self;
122 Page := UserSession.FPage;
123 Thumbnail := UserSession.FThumbnail;
124 s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
125 IWLabel2.BGColor := s;
126 IWLabel3.BGColor := s;
127 IWLabel5.BGColor := s;
128 IWLabel7.BGColor := s;
129 IWLabel8.BGColor := s;
130 IWRegion1.Width := i;
131 IWRegion2.Width := i;
132 IWRegion4.Width := i;
133 IWRegion5.Width := i;
134 IWRegion6.Width := i;
135 IWRegion7.Width := i;
136 WebApplication.RegisterCallBack('callback', CallBack);
137 end;
138
139 procedure TIWForm1.IWAppFormRender(Sender: TObject);
140 var
141 s: string;
142 i, j: Integer;
143 begin
144 IWList1.Items.Clear;
145 with DM.FDTable2 do
146 begin
147 if Filtered = true then
148 begin
149 FindFirst;
150 while Found = true do
151 begin
152 s := FieldByName('CATEGORY').AsString;
153 if s = '' then
154 begin
155 FindNext;
156 continue;
157 end;
158 i := IWList1.Items.IndexOfName(s);
159 if i = -1 then
160 IWList1.Items.Add(s + '=1')
161 else
162 begin
163 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
164 IWList1.Items[i] := s + '=' + j.ToString;
165 end;
166 FindNext;
167 end;
168 end
169 else
170 begin
171 First;
172 while Eof = false do
173 begin
174 s := FieldByName('CATEGORY').AsString;
175 if s = '' then
176 begin
177 Next;
178 continue;
179 end;
180 i := IWList1.Items.IndexOf(s);
181 if i = -1 then
182 IWList1.Items.Add(s);
183 Next;
184 end;
185 end;
186 end;
187 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 IWList2.Items.Clear;
197 if Page = false then
198 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 First;
208 i := 0;
209 while Eof = false do
210 begin
211 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
212 i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
213 IWList2.Items.Add(s);
214 Next;
215 end;
216 IWList2.Items.Add(i.ToString + '�~');
217 Close;
218 IWList3.Items.Clear;
219 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 Params.ParamByName('num').AsInteger := UserSession.user_number;
224 Open;
225 First;
226 while Eof = false do
227 begin
228 IWList3.Items.Add(Fields.Fields[0].AsString);
229 Next;
230 end;
231 Close;
232 end;
233 end;
234 LoadImage;
235 if IWGrid1.Visible = true then
236 IWLabel6.Visible := Filter;
237 end;
238
239 procedure TIWForm1.IWButton1Click(Sender: TObject);
240 var
241 i: Integer;
242 begin
243 IWFrame8IWLink1Click(Sender);
244 if IWEdit1.Text <> '' then
245 begin
246 DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
247 DM.FDTable2.Filtered := true;
248 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 end;
259 end;
260
261 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 WebApplication.ShowConfirm('�J�[�g��������������', 'callback', '����', '����', '������');
292 end;
293
294 procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
295 begin
296 Thumbnail := true;
297 end;
298
299 procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
300 const ARow, AColumn: Integer);
301 begin
302 Thumbnail := false;
303 IWFrame8.IWEdit1.Text := '1';
304 UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
305 end;
306
307 procedure TIWForm1.IWLink1Click(Sender: TObject);
308 begin
309 TUserForm.Create(WebApplication).Show;
310 end;
311
312 procedure TIWForm1.IWLink2Click(Sender: TObject);
313 begin
314 if Page = true then
315 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 end;
327
328 procedure TIWForm1.IWLink3Click(Sender: TObject);
329 begin
330 with TMyPage.Create(WebApplication) do
331 begin
332 Form := Self;
333 Show;
334 end;
335 end;
336
337 procedure TIWForm1.IWLink4Click(Sender: TObject);
338 begin
339 TCartForm.Create(WebApplication).Show;
340 end;
341
342 procedure TIWForm1.IWLink5Click(Sender: TObject);
343 begin
344 TIWForm10.Create(WebApplication).Show;
345 end;
346
347 procedure TIWForm1.IWLink6Click(Sender: TObject);
348 begin
349 Page:=true;
350 TIWForm3.Create(WebApplication).Show;
351 end;
352
353 procedure TIWForm1.LoadImage;
354 var
355 s: TStream;
356 png: TPngImage;
357 pic: TIWImage;
358 i: Integer;
359 j: Integer;
360 x: Boolean;
361 t: string;
362 label label1;
363 begin
364 ClearImage;
365 png := TPngImage.Create;
366 try
367 if Thumbnail = true then
368 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 begin
380 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 goto label1;
387 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 end;
400 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 end;
413 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 end;
426 end
427 else
428 IWFrame8.IWImage1.Picture.Assign(nil);
429 finally
430 png.Free;
431 end;
432 png := nil;
433 s := nil;
434 Randomize;
435 if DM.FDTable2.Filtered = true then
436 begin
437 x := true;
438 DM.FDTable2.Filtered := false;
439 end
440 else
441 x := false;
442 DM.FDTable2.Last;
443 if DM.FDTable2.Bof = true then
444 Exit;
445 DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
446 if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
447 begin
448 s := DM.FDTable2.CreateBlobStream
449 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
450 png := TPngImage.Create;
451 try
452 png.LoadFromStream(s);
453 IWImage1.Picture.Assign(png);
454 finally
455 png.Free;
456 s.Free;
457 end;
458 end;
459 if x = true then
460 DM.FDTable2.Filtered := true;
461 IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
462 end;
463
464 procedure TIWForm1.SetPage(const Value: Boolean);
465 begin
466 UserSession.FPage := Value;
467 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 begin
474 IWLabel1.Caption := '��������';
475 IWLink2.Caption := '���O�A�E�g';
476 UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
477 end
478 else
479 begin
480 IWLabel1.Caption := '���������Q�X�g�l';
481 IWLink2.Caption := '���O�C��';
482 Thumbnail := true;
483 IWText1.Text := '';
484 DM.FDTable2.Filtered := false;
485 Filter := false;
486 UserSession.user_number:=0;
487 end;
488 end;
489
490 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 initialization
498
499 TIWForm1.SetAsMainForm;
500
501 end.

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