Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (show annotations) (download) (as text)
Sat Dec 19 14:35:42 2015 UTC (8 years, 2 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 7209 byte(s)
IntraWebをバージョンアップしてから、コンパイルが可能になりました。お見苦しいところをお見せしていました。
まだまだ未完成です。
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
14 type
15 TIWForm1 = class(TIWAppForm)
16 IWFrame1: TIWFrame1;
17 IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
18 IWLabel1: TIWLabel;
19 IWDBLabel1: TIWDBLabel;
20 IWRegion1: TIWRegion;
21 IWRegion2: TIWRegion;
22 IWText1: TIWText;
23 IWGrid1: TIWGrid;
24 IWRegion3: TIWRegion;
25 IWRegion4: TIWRegion;
26 IWLink1: TIWLink;
27 IWLabel2: TIWLabel;
28 IWList1: TIWList;
29 IWLabel3: TIWLabel;
30 IWEdit1: TIWEdit;
31 IWButton1: TIWButton;
32 IWEdit2: TIWEdit;
33 IWEdit3: TIWEdit;
34 IWLink2: TIWLink;
35 IWRegion5: TIWRegion;
36 IWLabel7: TIWLabel;
37 IWRegion6: TIWRegion;
38 IWLabel8: TIWLabel;
39 IWList2: TIWList;
40 IWLabel4: TIWLabel;
41 IWImageFile1: TIWImageFile;
42 IWRegion7: TIWRegion;
43 IWLabel5: TIWLabel;
44 IWLabel6: TIWLabel;
45 IWList3: TIWList;
46 procedure IWAppFormRender(Sender: TObject);
47 procedure IWLink2Click(Sender: TObject);
48 procedure IWAppFormCreate(Sender: TObject);
49 procedure IWButton1Click(Sender: TObject);
50 procedure IWLink1Click(Sender: TObject);
51 private
52 function GetPage: TPage;
53 procedure SetPage(const Value: TPage);
54 procedure LoadImage;
55 procedure ClearImage;
56 public
57 property Page: TPage read GetPage write SetPage;
58 end;
59
60 implementation
61
62 {$R *.dfm}
63
64 uses Unit3, ServerController, Unit6;
65
66 procedure TIWForm1.ClearImage;
67 var
68 i: Integer;
69 j: Integer;
70 begin
71 for i := 0 to IWGrid1.RowCount - 1 do
72 for j := 0 to IWGrid1.ColumnCount - 1 do
73 IWGrid1.Cell[i, j].Control.Free;
74 end;
75
76 function TIWForm1.GetPage: TPage;
77 begin
78 result := UserSession.FPage;
79 end;
80
81 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
82 begin
83 Page := UserSession.FPage;
84 end;
85
86 procedure TIWForm1.IWAppFormRender(Sender: TObject);
87 var
88 s: string;
89 i, j: Integer;
90 begin
91 IWList1.Items.Clear;
92 with DM.FDTable2 do
93 begin
94 First;
95 while Eof = false do
96 begin
97 s := FieldByName('CATEGORY').AsString;
98 if s = '' then
99 begin
100 Next;
101 continue;
102 end;
103 if Filtered = true then
104 begin
105 i := IWList1.Items.IndexOfName(s);
106 if i = -1 then
107 IWList1.Items.Add(s + '=1')
108 else
109 begin
110 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
111 IWList1.Items[i] := s + '=' + j.ToString;
112 end;
113 end
114 else
115 begin
116 i := IWList1.Items.IndexOf(s);
117 if i = -1 then
118 IWList1.Items.Add(s);
119 end;
120 Next;
121 end;
122 end;
123 if DM.FDTable2.Filtered = true then
124 for i := 0 to IWList1.Items.Count - 1 do
125 begin
126 s := IWList1.Items.ValueFromIndex[i];
127 if s = '1' then
128 IWList1.Items[i] := IWList1.Items.Names[i]
129 else
130 IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
131 end;
132 IWList2.Items.Clear;
133 if Page = TPage.Info then
134 begin
135 with DM.FDQuery1 do
136 begin
137 SQL.Clear;
138 SQL.Add('select volume,name,price from cart_data join item_data');
139 SQL.Add(' on (cart_data.serial = item_data.serial)');
140 SQL.Add(' where number = :num;');
141 Params.ParamByName('num').AsInteger := UserSession.user_number;
142 Open;
143 First;
144 i := 0;
145 while Eof = false do
146 begin
147 s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
148 i := i + Fields.Fields[2].AsInteger;
149 IWList2.Items.Add(s);
150 Next;
151 end;
152 IWList2.Items.Add(i.ToString + '�~');
153 Close;
154 IWList3.Items.Clear;
155 SQL.Clear;
156 SQL.Add('select name from recent_data join item_data');
157 SQL.Add(' on (recent_data.serial = item_data.serial)');
158 SQL.Add(' where number = :num;');
159 Params.ParamByName('num').AsInteger := UserSession.user_number;
160 Open;
161 First;
162 while Eof = false do
163 begin
164 IWList3.Items.Add(Fields.Fields[0].AsString);
165 Next;
166 end;
167 Close;
168 end;
169 end;
170 LoadImage;
171 end;
172
173 procedure TIWForm1.IWButton1Click(Sender: TObject);
174 const
175 Filter = 'NAME like ''%s''';
176 begin
177 if IWEdit1.Text = '' then
178 DM.FDTable2.Filtered := false
179 else
180 begin
181 DM.FDTable2.Filter.Format(Filter, ['%' + IWEdit1.Text + '%']);
182 DM.FDTable2.Filtered := true;
183 IWLabel6.Caption := IWEdit1.Text + '����������������';
184 end;
185 IWLabel6.Visible := DM.FDTable2.Filtered;
186 end;
187
188 procedure TIWForm1.IWLink1Click(Sender: TObject);
189 begin
190 TUserForm.Create(WebApplication).Show;
191 Release;
192 end;
193
194 procedure TIWForm1.IWLink2Click(Sender: TObject);
195 const
196 Filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';
197 begin
198 case Page of
199 Main:
200 begin
201 DM.FDTable1.Filter.Format(Filter, [IWEdit2.Text, IWEdit3.Text]);
202 DM.FDTable1.Filtered := true;
203 if DM.FDTable1.RecordCount = 1 then
204 begin
205 Page := Info;
206 UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')
207 .AsInteger;
208 IWEdit2.Text := '';
209 end;
210 IWEdit3.Text := '';
211 end;
212 Info:
213 begin
214 DM.FDTable1.Filtered := false;
215 Page := Main;
216 end;
217 end;
218 IWLink1.Visible := UserSession.user_number = 0;
219 end;
220
221 procedure TIWForm1.LoadImage;
222 var
223 s: TStream;
224 png: TPngImage;
225 pic: TIWImageFile;
226 i: Integer;
227 j: Integer;
228 k: Integer;
229 begin
230 ClearImage;
231 png := TPngImage.Create;
232 try
233 IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
234 k := 1;
235 for i := 0 to IWGrid1.RowCount - 1 do
236 for j := 0 to IWGrid1.ColumnCount - 1 do
237 begin
238 s := DM.FDTable2.CreateBlobStream
239 (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
240 try
241 png.LoadFromStream(s);
242 pic := TIWImageFile.Create(IWGrid1);
243 pic.Picture.Assign(png);
244 IWGrid1.Cell[i, j].Control := pic;
245 IWGrid1.Cell[i, j].Text := k.ToString;
246 inc(k);
247 finally
248 s.Free;
249 end;
250 end;
251 finally
252 png.Free;
253 end;
254 end;
255
256 procedure TIWForm1.SetPage(const Value: TPage);
257 var
258 x: Boolean;
259 begin
260 UserSession.FPage := Value;
261 x := Value = Info;
262 IWRegion7.Visible := x;
263 IWLabel6.Visible := x;
264 IWDBLabel1.Visible := x;
265 IWLink1.Visible := not x;
266 IWText1.Visible := not x;
267 if x = true then
268 begin
269 IWLabel1.Caption := '��������';
270 IWLink2.Caption := '���O�A�E�g';
271 end
272 else
273 begin
274 IWLabel1.Caption := '���������Q�X�g�l';
275 IWLink2.Caption := '���O�C��';
276 end;
277 end;
278
279 initialization
280
281 TIWForm1.SetAsMainForm;
282
283 end.

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