Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit13.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 18 - (show annotations) (download) (as text)
Sat Aug 27 11:00:30 2016 UTC (7 years, 7 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 5092 byte(s)
データの更新をメンテナンス中に限定した
コミットファイルの設定を見直し

問題点はRecordCountを使った検索件数表示
1 unit Unit13;
2
3 interface
4
5 uses
6 Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, Vcl.Controls,
7 IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompButton,
8 IWCompExtCtrls, IWCompGrids, IWDBGrids, FireDAC.Stan.Intf,
9 FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
10 FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt,
11 Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, IWVCLComponent,
12 IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
13 IWTemplateProcessorHTML;
14
15 type
16 TMasterForm = class(TIWAppForm)
17 IWButton1: TIWButton;
18 IWRadioGroup1: TIWRadioGroup;
19 IWDBGrid1: TIWDBGrid;
20 DataSource1: TDataSource;
21 FDQuery1: TFDQuery;
22 IWRadioGroup2: TIWRadioGroup;
23 IWButton2: TIWButton;
24 IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
25 procedure IWButton1Click(Sender: TObject);
26 procedure IWRadioGroup1Click(Sender: TObject);
27 procedure IWAppFormCreate(Sender: TObject);
28 procedure IWDBGrid1RenderCell(ACell: TIWGridCell;
29 const ARow, AColumn: Integer);
30 procedure IWDBGrid1Render(Sender: TObject);
31 procedure IWAppFormDestroy(Sender: TObject);
32 procedure IWRadioGroup2Click(Sender: TObject);
33 procedure IWButton2Click(Sender: TObject);
34 private
35 dummy: TComponent;
36 procedure Agree(Sender: TObject);
37 public
38 end;
39
40 implementation
41
42 {$R *.dfm}
43
44 uses Unit3, ServerController;
45
46 procedure TMasterForm.Agree(Sender: TObject);
47 begin
48 if FDQuery1.Locate('SERIAL', (Sender as TIWButton).Tag) = true then
49 begin
50 if FDQuery1.FieldByName('SERIAL').AsInteger = -1 then
51 FDQuery1.Delete
52 else
53 begin
54 FDQuery1.Edit;
55 FDQuery1.FieldByName('AGREE').AsBoolean := true;
56 FDQuery1.Post;
57 end;
58 DM.FDTableView.Refresh;
59 end;
60 end;
61
62 procedure TMasterForm.IWAppFormCreate(Sender: TObject);
63 begin
64 FDQuery1.Open;
65 IWRadioGroup1Click(Sender);
66 end;
67
68 procedure TMasterForm.IWAppFormDestroy(Sender: TObject);
69 begin
70 FDQuery1.Close;
71 end;
72
73 procedure TMasterForm.IWButton1Click(Sender: TObject);
74 var
75 s: TList;
76 p: PInteger;
77 i, j: Integer;
78 begin
79 i := 1;
80 s := TList.Create;
81 try
82 DM.FDTable2.IndexFieldNames := 'SERIAL';
83 DM.FDTable2.Refresh;
84 DM.FDTable2.First;
85 while (DM.FDTable2.Eof = false) and (i < 100) do
86 begin
87 if DM.FDTable2.FieldByName('SERIAL').AsInteger <> i then
88 begin
89 New(p);
90 s.Add(p);
91 p^ := i;
92 end;
93 inc(i);
94 DM.FDTable2.Next;
95 end;
96 DM.FDTable2.Last;
97 while (DM.FDTable2.Bof = false) and (s.Count > 0) do
98 begin
99 p := s[0];
100 j := DM.FDTable2.FieldByName('SERIAL').AsInteger;
101 with DM.FDQuery1 do
102 begin
103 SQL.Clear;
104 SQL.Add('select serial from cart_data where serial = :num');
105 ParamByName('num').AsInteger := j;
106 Open;
107 First;
108 while Eof = false do
109 begin
110 Edit;
111 Fields[0].AsInteger := p^;
112 Post;
113 Next;
114 end;
115 SQL.Clear;
116 SQL.Add('select serial from recent_data where serial = :num');
117 ParamByName('num').AsInteger := j;
118 Open;
119 First;
120 while Eof = false do
121 begin
122 Edit;
123 Fields[0].AsInteger := p^;
124 Post;
125 Next;
126 end;
127 end;
128 DM.FDTable2.Edit;
129 DM.FDTable2.FieldByName('SERIAL').AsInteger := p^;
130 DM.FDTable2.Post;
131 DM.FDTable1.Prior;
132 System.Dispose(p);
133 s.Delete(0);
134 end;
135 finally
136 s.Free;
137 DM.FDTable2.IndexFieldNames := 'MASTER';
138 end;
139 end;
140
141 procedure TMasterForm.IWButton2Click(Sender: TObject);
142 begin
143 Release;
144 end;
145
146 procedure TMasterForm.IWDBGrid1Render(Sender: TObject);
147 begin
148 dummy.Free;
149 dummy := TComponent.Create(IWDBGrid1);
150 end;
151
152 procedure TMasterForm.IWDBGrid1RenderCell(ACell: TIWGridCell;
153 const ARow, AColumn: Integer);
154 var
155 s: TIWImage;
156 t: TIWButton;
157 begin
158 if (ARow = 0) or (IWRadioGroup2.ItemIndex <> 0) then
159 Exit;
160 if AColumn = FDQuery1.FieldByName('THUMBNAIL').Index then
161 begin
162 s := TIWImage.Create(dummy);
163 UserSession.FieldToImg(s.Picture, FDQuery1.FieldByName('THUMBNAIL'));
164 ACell.Control := s;
165 end
166 else if AColumn = FDQuery1.FieldByName('AGREE').Index then
167 begin
168 t := TIWButton.Create(dummy);
169 t.Tag := FDQuery1.FieldByName('SERIAL').AsInteger;
170 t.OnClick := Agree;
171 ACell.Control := t;
172 end;
173 end;
174
175 procedure TMasterForm.IWRadioGroup1Click(Sender: TObject);
176 begin
177 IWButton1.Enabled := IWRadioGroup1.ItemIndex = 1;
178 end;
179
180 procedure TMasterForm.IWRadioGroup2Click(Sender: TObject);
181 begin
182 case IWRadioGroup2.ItemIndex of
183 0:
184 FDQuery1.Open('select * from item_data where agree = false');
185 1:
186 FDQuery1.Open('select * from item_data where agree = true');
187 2:
188 FDQuery1.Open
189 ('select * from item_data where agree = true and activate = true');
190 end;
191 end;
192
193 end.

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