Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4 - (show annotations) (download) (as text)
Sun Dec 27 07:05:56 2015 UTC (8 years, 3 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 8515 byte(s)
ある程度できたので

画像の表示がわかりませんでした
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 IWLabel7.BGColor := s;
95 IWLabel8.BGColor := s;
96 IWRegion1.Width := i;
97 IWRegion2.Width := i;
98 IWRegion4.Width := i;
99 IWRegion5.Width := i;
100 IWRegion6.Width := i;
101 IWRegion7.Width := i;
102 end;
103
104 procedure TIWForm1.IWAppFormRender(Sender: TObject);
105 var
106 s: string;
107 i, j: Integer;
108 begin
109 IWList1.Items.Clear;
110 with DM.FDTable2 do
111 begin
112 if Filtered = true then
113 begin
114 FindFirst;
115 while Found = true do
116 begin
117 s := FieldByName('CATEGORY').AsString;
118 if s = '' then
119 begin
120 FindNext;
121 continue;
122 end;
123 i := IWList1.Items.IndexOfName(s);
124 if i = -1 then
125 IWList1.Items.Add(s + '=1')
126 else
127 begin
128 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
129 IWList1.Items[i] := s + '=' + j.ToString;
130 end;
131 FindNext;
132 end;
133 end
134 else
135 begin
136 First;
137 while Eof = false do
138 begin
139 s := FieldByName('CATEGORY').AsString;
140 if s = '' then
141 begin
142 Next;
143 continue;
144 end;
145 i := IWList1.Items.IndexOf(s);
146 if i = -1 then
147 IWList1.Items.Add(s);
148 Next;
149 end;
150 end;
151 end;
152 if DM.FDTable2.Filtered = true then
153 for i := 0 to IWList1.Items.Count - 1 do
154 begin
155 s := IWList1.Items.ValueFromIndex[i];
156 if s = '1' then
157 IWList1.Items[i] := IWList1.Items.Names[i]
158 else
159 IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
160 end;
161 IWList2.Items.Clear;
162 if Page = TPage.Info then
163 begin
164 with DM.FDQuery1 do
165 begin
166 SQL.Clear;
167 SQL.Add('select volume,name,price from cart_data join item_data');
168 SQL.Add(' on (cart_data.serial = item_data.serial)');
169 SQL.Add(' where number = :num;');
170 Params.ParamByName('num').AsInteger := UserSession.user_number;
171 Open;
172 First;
173 i := 0;
174 while Eof = false do
175 begin
176 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
177 i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
178 IWList2.Items.Add(s);
179 Next;
180 end;
181 IWList2.Items.Add(i.ToString + '�~');
182 Close;
183 IWList3.Items.Clear;
184 SQL.Clear;
185 SQL.Add('select name from recent_data join item_data');
186 SQL.Add(' on (recent_data.serial = item_data.serial)');
187 SQL.Add(' where number = :num;');
188 Params.ParamByName('num').AsInteger := UserSession.user_number;
189 Open;
190 First;
191 while Eof = false do
192 begin
193 IWList3.Items.Add(Fields.Fields[0].AsString);
194 Next;
195 end;
196 Close;
197 end;
198 end;
199 LoadImage;
200 IWLabel6.Visible:=DM.FDTable2.Filtered;
201 end;
202
203 procedure TIWForm1.IWButton1Click(Sender: TObject);
204 begin
205 DM.FDTable2.Filtered := false;
206 if IWEdit1.Text <> '' then
207 begin
208 DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
209 DM.FDTable2.Filtered := true;
210 IWLabel6.Caption := IWEdit1.Text + '����������������';
211 end;
212 IWLabel6.Visible := DM.FDTable2.Filtered;
213 end;
214
215 procedure TIWForm1.IWLink1Click(Sender: TObject);
216 begin
217 TUserForm.Create(WebApplication).Show;
218 end;
219
220 procedure TIWForm1.IWLink2Click(Sender: TObject);
221 begin
222 case Page of
223 Main:
224 begin
225 if DM.FDTable1.Locate('EMAIL;PASSWORD',
226 VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true
227 then
228 begin
229 Page := Info;
230 UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')
231 .AsInteger;
232 IWEdit2.Text := '';
233 end;
234 IWEdit3.Text := '';
235 end;
236 Info:
237 begin
238 DM.FDTable1.Filtered := false;
239 Page := Main;
240 end;
241 end;
242 end;
243
244 procedure TIWForm1.LoadImage;
245 var
246 s: TStream;
247 png: TPngImage;
248 pic: TIWImageFile;
249 i: Integer;
250 j: Integer;
251 k: Integer;
252 label label1;
253 begin
254 ClearImage;
255 png := TPngImage.Create;
256 try
257 IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
258 k := 1;
259 for i := 0 to IWGrid1.RowCount - 1 do
260 for j := 0 to IWGrid1.ColumnCount - 1 do
261 begin
262 if DM.FDTable2.FieldByName('THUMBNAIL') = nil then
263 continue;
264 s := DM.FDTable2.CreateBlobStream
265 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
266 try
267 png.LoadFromStream(s);
268 pic := TIWImageFile.Create(IWGrid1);
269 pic.Picture.Assign(png);
270 IWGrid1.Cell[i, j].Control := pic;
271 IWGrid1.Cell[i, j].Text := k.ToString;
272 inc(k);
273 finally
274 s.Free;
275 end;
276 if DM.FDTable2.Bof = true then
277 goto label1;
278 end;
279 label1:
280 finally
281 png.Free;
282 end;
283 png := nil;
284 s := nil;
285 Randomize;
286 DM.FDTable2.Last;
287 DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
288 if DM.FDTable2.FieldByName('THUMBNAIL') <> nil then
289 begin
290 s := DM.FDTable2.CreateBlobStream
291 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
292 png := TPngImage.Create;
293 try
294 png.LoadFromStream(s);
295 IWImageFile1.Picture.Assign(png);
296 finally
297 png.Free;
298 s.Free;
299 end;
300 end;
301 IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
302 end;
303
304 procedure TIWForm1.SetPage(const Value: TPage);
305 var
306 x: Boolean;
307 begin
308 UserSession.FPage := Value;
309 x := Value = Info;
310 IWRegion7.Visible := x;
311 IWDBLabel1.Visible := x;
312 IWLink1.Visible := not x;
313 IWText1.Visible := not x;
314 if x = true then
315 begin
316 IWLabel1.Caption := '��������';
317 IWLink2.Caption := '���O�A�E�g';
318 end
319 else
320 begin
321 IWLabel1.Caption := '���������Q�X�g�l';
322 IWLink2.Caption := '���O�C��';
323 end;
324 end;
325
326 initialization
327
328 TIWForm1.SetAsMainForm;
329
330 end.

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