Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

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