Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Sun Nov 22 11:18:44 2015 UTC (8 years, 4 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 9585 byte(s)
方向性はあってますが技術的に行き詰っています.IntraWebの情報・経験が不足しています.
ボタンでフォームを切り替えることさえうまくいきませんがセッションの問題でしょうか?
1 unit Unit1;
2
3 interface
4
5 uses
6 Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWHTMLControls,
7 IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
8 Vcl.Controls, Vcl.Forms, IWVCLBaseContainer, IWContainer, IWHTMLContainer,
9 IWHTML40Container, IWRegion, FireDAC.Stan.Intf, FireDAC.Stan.Option,
10 FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
11 FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.IB,
12 FireDAC.Phys.IBDef, Data.DB, FireDAC.Comp.Client, Datasnap.DBClient,
13 Datasnap.Provider, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,
14 FireDAC.DApt, FireDAC.Comp.DataSet, IWCompGrids, IWDBGrids, IWCompEdit,
15 IWDBStdCtrls, IWCompExtCtrls, IWDBExtCtrls, Unit3, IWVCLComponent,
16 IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
17 IWTemplateProcessorHTML, Data.Bind.EngExt, Vcl.Bind.DBEngExt, System.Rtti,
18 System.Bindings.Outputs, Vcl.Bind.Editors, Data.Bind.Components,
19 Data.Bind.DBScope, IWCompListbox, IWCompButton, Web.HTTPApp, Web.HTTPProd,
20 Vcl.ImgList, IWImageList, PngImage, IWCompTabControl, IWCompMemo, IWCompText,
21 UserSessionUnit;
22
23 type
24 TTopForm = class(TIWAppForm)
25 IWRegion1: TIWRegion;
26 IWLabel1: TIWLabel;
27 IWList1: TIWList;
28 IWLink1: TIWLink;
29 IWLabel2: TIWLabel;
30 IWDBLabel1: TIWDBLabel;
31 IWFrame1: TIWFrame1;
32 IWRegion3: TIWRegion;
33 IWLabel3: TIWLabel;
34 IWLabel4: TIWLabel;
35 IWRegion4: TIWRegion;
36 IWLabel5: TIWLabel;
37 IWList2: TIWList;
38 IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
39 IWRegion2: TIWRegion;
40 IWLabel6: TIWLabel;
41 IWRegion6: TIWRegion;
42 IWEdit1: TIWEdit;
43 IWButton1: TIWButton;
44 IWImageFile1: TIWImageFile;
45 IWRegion7: TIWRegion;
46 IWLabel8: TIWLabel;
47 IWGrid1: TIWGrid;
48 IWTabControl1: TIWTabControl;
49 IWTabControl1Page0: TIWTabPage;
50 IWTabControl1Page1: TIWTabPage;
51 IWText1: TIWText;
52 IWRegion8: TIWRegion;
53 IWEdit2: TIWEdit;
54 IWEdit3: TIWEdit;
55 IWLabel9: TIWLabel;
56 IWList3: TIWList;
57 IWLink2: TIWLink;
58 procedure IWAppFormRender(Sender: TObject);
59 procedure IWLink1Click(Sender: TObject);
60 procedure IWAppFormCreate(Sender: TObject);
61 procedure IWButton1Click(Sender: TObject);
62 procedure IWAppFormDestroy(Sender: TObject);
63 procedure IWLink2Click(Sender: TObject);
64 private
65 procedure SetPage(const Value: TPage);
66 function GetPage: TPage;
67 procedure LoadImage;
68 procedure ClearImage;
69 public
70 property Page: TPage read GetPage write SetPage;
71 end;
72
73 implementation
74
75 {$R *.dfm}
76
77 uses Unit2, ServerController, Unit4, Unit6;
78
79 procedure TTopForm.ClearImage;
80 var
81 i, j: integer;
82 begin
83 for i := 0 to IWGrid1.ColumnCount - 1 do
84 for j := 0 to IWGrid1.RowCount - 1 do
85 begin
86 IWGrid1.Cell[j, i].Control.Free;
87 IWGrid1.Cell[j, i].Control := nil;
88 end;
89 end;
90
91 function TTopForm.GetPage: TPage;
92 begin
93 result := UserSession.FPage;
94 end;
95
96 procedure TTopForm.IWAppFormCreate(Sender: TObject);
97 const
98 i = 150;
99 var
100 s: integer;
101 begin
102 s:=DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
103 IWLabel1.BGColor := s;
104 IWLabel3.BGColor := s;
105 IWLabel5.BGColor := s;
106 IWLabel6.BGColor := s;
107 IWLabel8.BGColor := s;
108 IWRegion1.Width := i;
109 IWRegion2.Width := i;
110 IWRegion3.Width := i;
111 IWRegion4.Width := i;
112 IWRegion7.Width := i;
113 IWRegion8.Width := i;
114 Page := UserSession.FPage;
115 end;
116
117 procedure TTopForm.IWAppFormDestroy(Sender: TObject);
118 begin
119 ClearImage;
120 end;
121
122 procedure TTopForm.IWAppFormRender(Sender: TObject);
123 var
124 s: string;
125 i, j: integer;
126 x: Boolean;
127 begin
128 IWList1.Items.Clear;
129 with DM.FDTable2 do
130 if RecordCount > 0 then
131 begin
132 First;
133 while Eof = false do
134 begin
135 s := FieldByName('CATEGORY').AsString;
136 if s = '' then
137 begin
138 Next;
139 continue;
140 end;
141 if Filtered = true then
142 begin
143 i := IWList1.Items.IndexOfName(s);
144 if i = -1 then
145 IWList1.Items.Add(s + '=1')
146 else
147 begin
148 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
149 IWList1.Items[i] := s + '=' + j.ToString;
150 end;
151 end
152 else
153 begin
154 i := IWList1.Items.IndexOf(s);
155 if i = -1 then
156 IWList1.Items.Add(s);
157 end;
158 Next;
159 end;
160 end;
161 if DM.FDTable2.Filtered = true then
162 for i := 0 to IWList1.Items.Count - 1 do
163 begin
164 s := IWList1.Items.ValueFromIndex[i];
165 if s = '1' then
166 IWList1.Items[i] := IWList1.Items.Names[i]
167 else
168 IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
169 end;
170 IWList3.Items.Clear;
171 if Page = Info then
172 begin
173 with DM.FDQuery1 do
174 begin
175 SQL.Clear;
176 SQL.Add('select volume,name,price from cart_data join item_data');
177 SQL.Add(' on (cart_data.serial = item_data.serial)');
178 SQL.Add(' where number = :num;');
179 Params.ParamByName('num').AsInteger := UserSession.user_number;
180 Open;
181 if RecordCount > 0 then
182 begin
183 First;
184 i := 0;
185 while Eof = false do
186 begin
187 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
188 inc(i, Fields.Fields[2].AsInteger);
189 IWList3.Items.Add(s);
190 Next;
191 end;
192 IWList3.Items.Add(i.ToString + '�~');
193 end;
194 Close;
195 end;
196 IWList2.Items.Clear;
197 with DM.FDQuery1 do
198 begin
199 SQL.Clear;
200 SQL.Add('select name from recent_data join item_data');
201 SQL.Add(' on (recent_data.serial = item_data.serial)');
202 SQL.Add(' where number = :num;');
203 //Params.ParamByName('num').AsInteger:=UserSession.user_number;
204 Open;
205 if RecordCount > 0 then
206 begin
207 First;
208 while Eof = false do
209 begin
210 IWList2.Items.Add(Fields.Fields[0].AsString);
211 Next;
212 end;
213 end;
214 Close;
215 end;
216 end;
217 x := Page = Info;
218 IWRegion4.Visible := x;
219 IWLabel2.Visible := x;
220 IWDBLabel1.Visible := x;
221 IWLink2.Visible := not x;
222 LoadImage;
223 end;
224
225 procedure TTopForm.IWButton1Click(Sender: TObject);
226 const
227 filter = 'NAME LIKE ''%s''';
228 begin
229 if IWEdit1.Text = '' then
230 DM.FDTable2.Filtered := false
231 else
232 begin
233 DM.FDTable2.filter := Format(filter, ['%' + IWEdit1.Text + '%']);
234 DM.FDTable2.Filtered := true;
235 IWLabel9.Text := IWEdit1.Text + '����������������';
236 end;
237 IWLabel9.Visible := DM.FDTable2.Filtered;
238 end;
239
240 procedure TTopForm.IWLink1Click(Sender: TObject);
241 const
242 filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';
243 begin
244 case Page of
245 Main:
246 begin
247 DM.FDTable1.filter := Format(filter, [IWEdit2.Text, IWEdit3.Text]);
248 DM.FDTable1.Filtered := true;
249 if DM.FDTable1.RecordCount = 1 then
250 begin
251 IWLink1.Caption := '���O�A�E�g';
252 Page := Info;
253 UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')
254 .AsInteger;
255 IWEdit2.Text := '';
256 end;
257 IWEdit3.Text := '';
258 end;
259 Info:
260 begin
261 DM.FDTable1.Filtered := false;
262 IWLink1.Caption := '���O�C��';
263 Page := Main;
264 DM.FDQuery1.Params.ParamByName('num').AsInteger := 0;
265 end;
266 end;
267 IWLabel9.Visible := UserSession.user_number <> 0;
268 end;
269
270 procedure TTopForm.IWLink2Click(Sender: TObject);
271 begin
272 UserSession.FPage := Info;
273 TUserForm.Create(WebApplication).Show;
274 end;
275
276 procedure TTopForm.LoadImage;
277 var
278 i, j, k: integer;
279 png: TPngImage;
280 pic: TIWImageFile;
281 st: TStream;
282 label label1;
283 begin
284 ClearImage;
285 if DM.FDTable2.RecordCount > 0 then
286 begin
287 IWGrid1.RowCount := (DM.FDTable2.RecordCount div IWGrid1.ColumnCount) + 1;
288 k := 1;
289 DM.FDTable2.Last;
290 png := TPngImage.Create;
291 try
292 for i := 0 to IWGrid1.RowCount - 1 do
293 begin
294 for j := 0 to IWGrid1.ColumnCount - 1 do
295 begin
296 st := DM.FDTable2.CreateBlobStream
297 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
298 try
299 png.LoadFromStream(st);
300 pic := TIWImageFile.Create(Self);
301 pic.Picture.Assign(png);
302 IWGrid1.Cell[i, j].Control := pic;
303 IWGrid1.Cell[i, j].Text := k.ToString;
304 inc(k);
305 DM.FDTable2.Prior;
306 finally
307 st.Free;
308 end;
309 if DM.FDTable2.Bof = true then
310 goto label1;
311 end;
312 end;
313 label1:
314 finally
315 png.Free;
316 end;
317 end
318 else
319 IWGrid1.RowCount := 0;
320 st := nil;
321 png := nil;
322 Randomize;
323 DM.FDTable2.Last;
324 DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
325 st := DM.FDTable2.CreateBlobStream
326 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
327 png := TPngImage.Create;
328 try
329 png.LoadFromStream(st);
330 IWImageFile1.Picture.Assign(png);
331 finally
332 st.Free;
333 png.Free;
334 end;
335 IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
336 end;
337
338 procedure TTopForm.SetPage(const Value: TPage);
339 var
340 s: string;
341 begin
342 UserSession.FPage := Value;
343 case Value of
344 Main:
345 s := 'toppage.htm';
346 Info:
347 s := 'mypage.htm';
348 end;
349 IWTemplateProcessorHTML1.Templates.Default := s;
350 end;
351
352 initialization
353
354 TTopForm.SetAsMainForm;
355
356 end.

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