Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide 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 yamat0jp 1 unit Unit1;
2    
3     interface
4    
5     uses
6 yamat0jp 2 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 yamat0jp 1 IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
11 yamat0jp 2 IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12 yamat0jp 3 IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB,
13     IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14     IWCompMenu, Vcl.Menus, System.Variants;
15 yamat0jp 1
16     type
17 yamat0jp 2 TIWForm1 = class(TIWAppForm)
18     IWFrame1: TIWFrame1;
19     IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
20     IWLabel1: TIWLabel;
21     IWDBLabel1: TIWDBLabel;
22 yamat0jp 1 IWRegion1: TIWRegion;
23 yamat0jp 2 IWRegion2: TIWRegion;
24     IWText1: TIWText;
25     IWGrid1: TIWGrid;
26     IWRegion3: TIWRegion;
27     IWRegion4: TIWRegion;
28 yamat0jp 1 IWLink1: TIWLink;
29     IWLabel2: TIWLabel;
30 yamat0jp 2 IWList1: TIWList;
31 yamat0jp 1 IWLabel3: TIWLabel;
32     IWEdit1: TIWEdit;
33     IWButton1: TIWButton;
34 yamat0jp 2 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 yamat0jp 1 IWImageFile1: TIWImageFile;
44     IWRegion7: TIWRegion;
45 yamat0jp 2 IWLabel5: TIWLabel;
46     IWLabel6: TIWLabel;
47 yamat0jp 1 IWList3: TIWList;
48     procedure IWAppFormRender(Sender: TObject);
49 yamat0jp 2 procedure IWLink2Click(Sender: TObject);
50 yamat0jp 1 procedure IWAppFormCreate(Sender: TObject);
51     procedure IWButton1Click(Sender: TObject);
52 yamat0jp 2 procedure IWLink1Click(Sender: TObject);
53 yamat0jp 1 private
54 yamat0jp 2 function GetPage: TPage;
55 yamat0jp 1 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 yamat0jp 2 uses Unit3, ServerController, Unit6;
67 yamat0jp 1
68 yamat0jp 2 procedure TIWForm1.ClearImage;
69 yamat0jp 1 var
70 yamat0jp 2 i: Integer;
71     j: Integer;
72 yamat0jp 1 begin
73 yamat0jp 2 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 yamat0jp 1 end;
77    
78 yamat0jp 2 function TIWForm1.GetPage: TPage;
79 yamat0jp 1 begin
80     result := UserSession.FPage;
81     end;
82    
83 yamat0jp 2 procedure TIWForm1.IWAppFormCreate(Sender: TObject);
84 yamat0jp 3 const
85     i = 120;
86     var
87     s: Integer;
88 yamat0jp 1 begin
89     Page := UserSession.FPage;
90 yamat0jp 3 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 yamat0jp 1 end;
101    
102 yamat0jp 2 procedure TIWForm1.IWAppFormRender(Sender: TObject);
103 yamat0jp 1 var
104     s: string;
105 yamat0jp 2 i, j: Integer;
106 yamat0jp 1 begin
107     IWList1.Items.Clear;
108     with DM.FDTable2 do
109 yamat0jp 2 begin
110 yamat0jp 3 if Filtered = true then
111 yamat0jp 1 begin
112 yamat0jp 3 FindFirst;
113     while Found = true do
114 yamat0jp 1 begin
115 yamat0jp 3 s := FieldByName('CATEGORY').AsString;
116     if s = '' then
117     begin
118     FindNext;
119     continue;
120     end;
121 yamat0jp 2 i := IWList1.Items.IndexOfName(s);
122     if i = -1 then
123     IWList1.Items.Add(s + '=1')
124 yamat0jp 1 else
125     begin
126 yamat0jp 2 j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
127     IWList1.Items[i] := s + '=' + j.ToString;
128 yamat0jp 1 end;
129 yamat0jp 3 FindNext;
130     end;
131     end
132     else
133     begin
134     First;
135     while Eof = false do
136 yamat0jp 2 begin
137 yamat0jp 3 s := FieldByName('CATEGORY').AsString;
138     if s = '' then
139     begin
140     Next;
141     continue;
142     end;
143 yamat0jp 2 i := IWList1.Items.IndexOf(s);
144     if i = -1 then
145     IWList1.Items.Add(s);
146 yamat0jp 3 Next;
147 yamat0jp 1 end;
148     end;
149 yamat0jp 2 end;
150 yamat0jp 1 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 yamat0jp 2 IWList2.Items.Clear;
160     if Page = TPage.Info then
161 yamat0jp 1 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 yamat0jp 2 First;
171     i := 0;
172     while Eof = false do
173 yamat0jp 1 begin
174 yamat0jp 2 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 yamat0jp 1 end;
179 yamat0jp 2 IWList2.Items.Add(i.ToString + '�~');
180 yamat0jp 1 Close;
181 yamat0jp 2 IWList3.Items.Clear;
182 yamat0jp 1 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 yamat0jp 2 Params.ParamByName('num').AsInteger := UserSession.user_number;
187 yamat0jp 1 Open;
188 yamat0jp 2 First;
189     while Eof = false do
190 yamat0jp 1 begin
191 yamat0jp 2 IWList3.Items.Add(Fields.Fields[0].AsString);
192     Next;
193 yamat0jp 1 end;
194     Close;
195     end;
196     end;
197     LoadImage;
198     end;
199    
200 yamat0jp 2 procedure TIWForm1.IWButton1Click(Sender: TObject);
201 yamat0jp 1 begin
202 yamat0jp 3 DM.FDTable2.Filtered := false;
203     if IWEdit1.Text <> '' then
204 yamat0jp 1 begin
205 yamat0jp 3 DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%'+IWEdit1.Text+'%');
206 yamat0jp 1 DM.FDTable2.Filtered := true;
207 yamat0jp 2 IWLabel6.Caption := IWEdit1.Text + '����������������';
208 yamat0jp 1 end;
209 yamat0jp 2 IWLabel6.Visible := DM.FDTable2.Filtered;
210 yamat0jp 1 end;
211    
212 yamat0jp 2 procedure TIWForm1.IWLink1Click(Sender: TObject);
213     begin
214     TUserForm.Create(WebApplication).Show;
215     end;
216    
217     procedure TIWForm1.IWLink2Click(Sender: TObject);
218 yamat0jp 1 begin
219     case Page of
220     Main:
221     begin
222 yamat0jp 3 if DM.FDTable1.Locate('EMAIL;PASSWORD',
223     VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true
224     then
225 yamat0jp 1 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 yamat0jp 2 procedure TIWForm1.LoadImage;
242 yamat0jp 1 var
243 yamat0jp 2 s: TStream;
244 yamat0jp 1 png: TPngImage;
245     pic: TIWImageFile;
246 yamat0jp 2 i: Integer;
247     j: Integer;
248     k: Integer;
249 yamat0jp 3 label label1;
250 yamat0jp 1 begin
251     ClearImage;
252 yamat0jp 3 exit;
253     png:=TPngImage.Create;
254 yamat0jp 2 try
255     IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
256 yamat0jp 1 k := 1;
257 yamat0jp 2 for i := 0 to IWGrid1.RowCount - 1 do
258     for j := 0 to IWGrid1.ColumnCount - 1 do
259 yamat0jp 1 begin
260 yamat0jp 2 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 yamat0jp 1 end;
272 yamat0jp 3 if DM.FDTable2.Bof = true then
273     goto label1;
274 yamat0jp 1 end;
275 yamat0jp 3 label1:
276 yamat0jp 1 finally
277     png.Free;
278     end;
279 yamat0jp 3 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 yamat0jp 1 end;
296    
297 yamat0jp 2 procedure TIWForm1.SetPage(const Value: TPage);
298 yamat0jp 1 var
299 yamat0jp 2 x: Boolean;
300 yamat0jp 1 begin
301     UserSession.FPage := Value;
302 yamat0jp 2 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 yamat0jp 1 end;
318     end;
319    
320     initialization
321    
322 yamat0jp 2 TIWForm1.SetAsMainForm;
323 yamat0jp 1
324     end.

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