Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Unit13.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 19 - (show annotations) (download) (as text)
Sat Aug 27 13:22:00 2016 UTC (7 years, 9 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 5588 byte(s)
暫く制作から離れたいのでコミット
データベースに追加したフィールドがありますメンテナンスフォームも一応表示できます
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 str: string;
36 dummy: TComponent;
37 procedure Agree(Sender: TObject);
38 public
39 end;
40
41 implementation
42
43 {$R *.dfm}
44
45 uses Unit3, ServerController;
46
47 procedure TMasterForm.Agree(Sender: TObject);
48 begin
49 if (IWRadioGroup1.ItemIndex = 1) and
50 (FDQuery1.Locate('SERIAL', (Sender as TIWButton).Tag) = true) then
51 begin
52 if FDQuery1.FieldByName('SERIAL').AsInteger = -1 then
53 FDQuery1.Delete
54 else
55 begin
56 FDQuery1.Edit;
57 FDQuery1.FieldByName('AGREE').AsBoolean := true;
58 FDQuery1.Post;
59 end;
60 DM.FDTableView.Refresh;
61 end;
62 end;
63
64 procedure TMasterForm.IWAppFormCreate(Sender: TObject);
65 begin
66 FDQuery1.Open;
67 if DM.FDTable3.FieldByName('ENABLE').AsBoolean = true then
68 IWRadioGroup1.ItemIndex := 0
69 else
70 IWRadioGroup1.ItemIndex := 1;
71 IWRadioGroup1Click(Sender);
72 end;
73
74 procedure TMasterForm.IWAppFormDestroy(Sender: TObject);
75 begin
76 FDQuery1.Close;
77 end;
78
79 procedure TMasterForm.IWButton1Click(Sender: TObject);
80 var
81 s: TList;
82 p: PInteger;
83 i, j: Integer;
84 begin
85 i := 1;
86 s := TList.Create;
87 try
88 DM.FDTable2.IndexFieldNames := 'SERIAL';
89 DM.FDTable2.Refresh;
90 DM.FDTable2.First;
91 while (DM.FDTable2.Eof = false) and (i < 100) do
92 begin
93 if DM.FDTable2.FieldByName('SERIAL').AsInteger <> i then
94 begin
95 New(p);
96 s.Add(p);
97 p^ := i;
98 end;
99 inc(i);
100 DM.FDTable2.Next;
101 end;
102 DM.FDTable2.Last;
103 while (DM.FDTable2.Bof = false) and (s.Count > 0) do
104 begin
105 p := s[0];
106 j := DM.FDTable2.FieldByName('SERIAL').AsInteger;
107 with DM.FDQuery1 do
108 begin
109 SQL.Clear;
110 SQL.Add('select serial from cart_data where serial = :num');
111 ParamByName('num').AsInteger := j;
112 Open;
113 First;
114 while Eof = false do
115 begin
116 Edit;
117 Fields[0].AsInteger := p^;
118 Post;
119 Next;
120 end;
121 SQL.Clear;
122 SQL.Add('select serial from recent_data where serial = :num');
123 ParamByName('num').AsInteger := j;
124 Open;
125 First;
126 while Eof = false do
127 begin
128 Edit;
129 Fields[0].AsInteger := p^;
130 Post;
131 Next;
132 end;
133 end;
134 DM.FDTable2.Edit;
135 DM.FDTable2.FieldByName('SERIAL').AsInteger := p^;
136 DM.FDTable2.Post;
137 DM.FDTable1.Prior;
138 System.Dispose(p);
139 s.Delete(0);
140 end;
141 finally
142 s.Free;
143 DM.FDTable2.IndexFieldNames := 'MASTER';
144 end;
145 end;
146
147 procedure TMasterForm.IWButton2Click(Sender: TObject);
148 begin
149 Release;
150 end;
151
152 procedure TMasterForm.IWDBGrid1Render(Sender: TObject);
153 begin
154 dummy.Free;
155 dummy := TComponent.Create(IWDBGrid1);
156 end;
157
158 procedure TMasterForm.IWDBGrid1RenderCell(ACell: TIWGridCell;
159 const ARow, AColumn: Integer);
160 var
161 s: TIWImage;
162 t: TIWButton;
163 begin
164 if (ARow = 0) or (IWRadioGroup2.ItemIndex <> 0) then
165 Exit;
166 case AColumn of
167 0:
168 if FDQuery1.FieldByName('SERIAL').AsInteger = -1 then
169 str := '����'
170 else
171 str := '����';
172 3:
173 begin
174 s := TIWImage.Create(dummy);
175 UserSession.FieldToImg(s.Picture, FDQuery1.FieldByName('THUMBNAIL'));
176 ACell.Control := s;
177 end;
178 9:
179 begin
180 t := TIWButton.Create(dummy);
181 t.Tag := FDQuery1.FieldByName('SERIAL').AsInteger;
182 t.Caption := str;
183 t.OnClick := Agree;
184 ACell.Control := t;
185 end;
186 end;
187 end;
188
189 procedure TMasterForm.IWRadioGroup1Click(Sender: TObject);
190 var
191 x: Boolean;
192 begin
193 x := IWRadioGroup1.ItemIndex = 0;
194 IWButton1.Enabled := not x;
195 if Sender <> Self then
196 with DM.FDTable3 do
197 begin
198 Edit;
199 FieldByName('ENABLE').AsBoolean := x;
200 Post;
201 end;
202 end;
203
204 procedure TMasterForm.IWRadioGroup2Click(Sender: TObject);
205 begin
206 case IWRadioGroup2.ItemIndex of
207 0:
208 FDQuery1.Open('select * from item_data where agree = false');
209 1:
210 FDQuery1.Open('select * from item_data where agree = true');
211 2:
212 FDQuery1.Open
213 ('select * from item_data where agree = true and activate = true');
214 end;
215 end;
216
217 end.

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