Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations) (download) (as text)
Sat Dec 26 07:30:17 2015 UTC (8 years, 3 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 8247 byte(s)
ユーザー登録フォームを作成

DataSetのFilter処理を正しいものに訂正


文字化け、画像表示に問題あり
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, UserSessionUnit, PngImage, Data.DB,
13 IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14 IWCompMenu, Vcl.Menus, System.Variants;
15
16 type
17 TIWForm1 = class(TIWAppForm)
18 IWFrame1: TIWFrame1;
19 IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
20 IWLabel1: TIWLabel;
21 IWDBLabel1: TIWDBLabel;
22 IWRegion1: TIWRegion;
23 IWRegion2: TIWRegion;
24 IWText1: TIWText;
25 IWGrid1: TIWGrid;
26 IWRegion3: TIWRegion;
27 IWRegion4: TIWRegion;
28 IWLink1: TIWLink;
29 IWLabel2: TIWLabel;
30 IWList1: TIWList;
31 IWLabel3: TIWLabel;
32 IWEdit1: TIWEdit;
33 IWButton1: TIWButton;
34 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 IWImageFile1: TIWImageFile;
44 IWRegion7: TIWRegion;
45 IWLabel5: TIWLabel;
46 IWLabel6: TIWLabel;
47 IWList3: TIWList;
48 procedure IWAppFormRender(Sender: TObject);
49 procedure IWLink2Click(Sender: TObject);
50 procedure IWAppFormCreate(Sender: TObject);
51 procedure IWButton1Click(Sender: TObject);
52 procedure IWLink1Click(Sender: TObject);
53 private
54 function GetPage: TPage;
55 procedure SetPage(const Value: TPage);
56 procedure LoadImage;
57 procedure ClearImage;
58 public
59 property Page: TPage read GetPage write SetPage;
60 end;
61
62 implementation
63
64 {$R *.dfm}
65
66 uses Unit3, ServerController, Unit6;
67
68 procedure TIWForm1.ClearImage;
69 var
70 i: Integer;
71 j: Integer;
72 begin
73 for i := 0 to IWGrid1.RowCount - 1 do
74 for j := 0 to IWGrid1.ColumnCount - 1 do
75 IWGrid1.Cell[i, j].Control.Free;
76 end;
77
78 function TIWForm1.GetPage: TPage;
79 begin
80 result := UserSession.FPage;
81 end;
82
83 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
84 const
85 i = 120;
86 var
87 s: Integer;
88 begin
89 Page := UserSession.FPage;
90 s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
91 IWLabel2.BGColor := s;
92 IWLabel3.BGColor := s;
93 IWLabel5.BGColor := s;
94 IWRegion1.Width := i;
95 IWRegion2.Width := i;
96 IWRegion4.Width := i;
97 IWRegion5.Width := i;
98 IWRegion6.Width := i;
99 IWRegion7.Width := i;
100 end;
101
102 procedure TIWForm1.IWAppFormRender(Sender: TObject);
103 var
104 s: string;
105 i, j: Integer;
106 begin
107 IWList1.Items.Clear;
108 with DM.FDTable2 do
109 begin
110 if Filtered = true then
111 begin
112 FindFirst;
113 while Found = true do
114 begin
115 s := FieldByName('CATEGORY').AsString;
116 if s = '' then
117 begin
118 FindNext;
119 continue;
120 end;
121 i := IWList1.Items.IndexOfName(s);
122 if i = -1 then
123 IWList1.Items.Add(s + '=1')
124 else
125 begin
126 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
127 IWList1.Items[i] := s + '=' + j.ToString;
128 end;
129 FindNext;
130 end;
131 end
132 else
133 begin
134 First;
135 while Eof = false do
136 begin
137 s := FieldByName('CATEGORY').AsString;
138 if s = '' then
139 begin
140 Next;
141 continue;
142 end;
143 i := IWList1.Items.IndexOf(s);
144 if i = -1 then
145 IWList1.Items.Add(s);
146 Next;
147 end;
148 end;
149 end;
150 if DM.FDTable2.Filtered = true then
151 for i := 0 to IWList1.Items.Count - 1 do
152 begin
153 s := IWList1.Items.ValueFromIndex[i];
154 if s = '1' then
155 IWList1.Items[i] := IWList1.Items.Names[i]
156 else
157 IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
158 end;
159 IWList2.Items.Clear;
160 if Page = TPage.Info then
161 begin
162 with DM.FDQuery1 do
163 begin
164 SQL.Clear;
165 SQL.Add('select volume,name,price from cart_data join item_data');
166 SQL.Add(' on (cart_data.serial = item_data.serial)');
167 SQL.Add(' where number = :num;');
168 Params.ParamByName('num').AsInteger := UserSession.user_number;
169 Open;
170 First;
171 i := 0;
172 while Eof = false do
173 begin
174 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
175 i := i + Fields.Fields[2].AsInteger;
176 IWList2.Items.Add(s);
177 Next;
178 end;
179 IWList2.Items.Add(i.ToString + '�~');
180 Close;
181 IWList3.Items.Clear;
182 SQL.Clear;
183 SQL.Add('select name from recent_data join item_data');
184 SQL.Add(' on (recent_data.serial = item_data.serial)');
185 SQL.Add(' where number = :num;');
186 Params.ParamByName('num').AsInteger := UserSession.user_number;
187 Open;
188 First;
189 while Eof = false do
190 begin
191 IWList3.Items.Add(Fields.Fields[0].AsString);
192 Next;
193 end;
194 Close;
195 end;
196 end;
197 LoadImage;
198 end;
199
200 procedure TIWForm1.IWButton1Click(Sender: TObject);
201 begin
202 DM.FDTable2.Filtered := false;
203 if IWEdit1.Text <> '' then
204 begin
205 DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%'+IWEdit1.Text+'%');
206 DM.FDTable2.Filtered := true;
207 IWLabel6.Caption := IWEdit1.Text + '����������������';
208 end;
209 IWLabel6.Visible := DM.FDTable2.Filtered;
210 end;
211
212 procedure TIWForm1.IWLink1Click(Sender: TObject);
213 begin
214 TUserForm.Create(WebApplication).Show;
215 end;
216
217 procedure TIWForm1.IWLink2Click(Sender: TObject);
218 begin
219 case Page of
220 Main:
221 begin
222 if DM.FDTable1.Locate('EMAIL;PASSWORD',
223 VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true
224 then
225 begin
226 Page := Info;
227 UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')
228 .AsInteger;
229 IWEdit2.Text := '';
230 end;
231 IWEdit3.Text := '';
232 end;
233 Info:
234 begin
235 DM.FDTable1.Filtered := false;
236 Page := Main;
237 end;
238 end;
239 end;
240
241 procedure TIWForm1.LoadImage;
242 var
243 s: TStream;
244 png: TPngImage;
245 pic: TIWImageFile;
246 i: Integer;
247 j: Integer;
248 k: Integer;
249 label label1;
250 begin
251 ClearImage;
252 exit;
253 png:=TPngImage.Create;
254 try
255 IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
256 k := 1;
257 for i := 0 to IWGrid1.RowCount - 1 do
258 for j := 0 to IWGrid1.ColumnCount - 1 do
259 begin
260 s := DM.FDTable2.CreateBlobStream
261 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
262 try
263 png.LoadFromStream(s);
264 pic := TIWImageFile.Create(IWGrid1);
265 pic.Picture.Assign(png);
266 IWGrid1.Cell[i, j].Control := pic;
267 IWGrid1.Cell[i, j].Text := k.ToString;
268 inc(k);
269 finally
270 s.Free;
271 end;
272 if DM.FDTable2.Bof = true then
273 goto label1;
274 end;
275 label1:
276 finally
277 png.Free;
278 end;
279 png := nil;
280 s := nil;
281 Randomize;
282 DM.FDTable2.Last;
283 DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
284 s := DM.FDTable2.CreateBlobStream
285 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
286 png := TPngImage.Create;
287 try
288 png.LoadFromStream(s);
289 IWImageFile1.Picture.Assign(png);
290 finally
291 png.Free;
292 s.Free;
293 end;
294 IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
295 end;
296
297 procedure TIWForm1.SetPage(const Value: TPage);
298 var
299 x: Boolean;
300 begin
301 UserSession.FPage := Value;
302 x := Value = Info;
303 IWRegion7.Visible := x;
304 IWLabel6.Visible := x;
305 IWDBLabel1.Visible := x;
306 IWLink1.Visible := not x;
307 IWText1.Visible := not x;
308 if x = true then
309 begin
310 IWLabel1.Caption := '��������';
311 IWLink2.Caption := '���O�A�E�g';
312 end
313 else
314 begin
315 IWLabel1.Caption := '���������Q�X�g�l';
316 IWLink2.Caption := '���O�C��';
317 end;
318 end;
319
320 initialization
321
322 TIWForm1.SetAsMainForm;
323
324 end.

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