Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Unit5.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (hide annotations) (download) (as text)
Wed Aug 24 12:31:07 2016 UTC (7 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 4689 byte(s)
ご注文内容発送フォームがしっくりいくようになりました。
1 yamat0jp 1 unit Unit5;
2    
3     interface
4    
5     uses
6     Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWVCLComponent,
7     IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
8     IWTemplateProcessorHTML, Vcl.Controls, IWVCLBaseControl, IWBaseControl,
9 yamat0jp 10 IWBaseHTMLControl, IWControl, IWCompButton, IWCompGrids, IWCompListbox,
10 yamat0jp 14 IWCompLabel, IWDBStdCtrls, IWCompCheckbox, System.Variants, IWDBGrids,
11     FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
12     FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
13     FireDAC.Stan.Async, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,
14 yamat0jp 17 FireDAC.Comp.Client, UITypes;
15 yamat0jp 1
16     type
17 yamat0jp 12 TAdminPage = class(TIWAppForm)
18 yamat0jp 1 IWButton1: TIWButton;
19     IWButton2: TIWButton;
20     IWButton3: TIWButton;
21     IWButton4: TIWButton;
22 yamat0jp 10 IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
23 yamat0jp 12 IWCheckBox1: TIWCheckBox;
24 yamat0jp 13 IWDBLabel1: TIWDBLabel;
25     IWDBLabel2: TIWDBLabel;
26     IWDBGrid1: TIWDBGrid;
27     IWDBNavigator1: TIWDBNavigator;
28     IWButton5: TIWButton;
29 yamat0jp 14 IWDBGrid2: TIWDBGrid;
30     FDQuery1: TFDQuery;
31     user_info: TDataSource;
32 yamat0jp 10 procedure IWButton1Click(Sender: TObject);
33     procedure IWButton4Click(Sender: TObject);
34 yamat0jp 13 procedure IWAppFormCreate(Sender: TObject);
35     procedure IWButton5Click(Sender: TObject);
36 yamat0jp 14 procedure FDQuery1AfterScroll(DataSet: TDataSet);
37     procedure IWDBNavigator1First(Sender: TObject);
38     procedure IWDBNavigator1Last(Sender: TObject);
39     procedure IWDBNavigator1Next(Sender: TObject);
40     procedure IWDBNavigator1Prior(Sender: TObject);
41 yamat0jp 17 procedure IWDBGrid2RenderCell(ACell: TIWGridCell;
42     const ARow, AColumn: Integer);
43     procedure IWDBGrid2Render(Sender: TObject);
44     procedure IWCheckBox1Change(Sender: TObject);
45     private
46     dummy: TComponent;
47 yamat0jp 1 public
48     end;
49    
50     implementation
51    
52     {$R *.dfm}
53    
54 yamat0jp 10 uses Unit3;
55 yamat0jp 1
56 yamat0jp 14 procedure TAdminPage.FDQuery1AfterScroll(DataSet: TDataSet);
57     begin
58 yamat0jp 17 if DM.FDTable5.MasterSource = DM.order then
59     IWDBGrid1.RowCurrentColor := TColorRec.Red
60     else
61     IWDBGrid1.RowCurrentColor := TColorRec.White;
62 yamat0jp 14 end;
63    
64 yamat0jp 12 procedure TAdminPage.IWAppFormCreate(Sender: TObject);
65 yamat0jp 10 begin
66 yamat0jp 17 if DM.FDTable5.MasterSource = nil then
67     DM.FDTable5.MasterSource := DM.order;
68     DM.FDTable6.First;
69 yamat0jp 14 FDQuery1.Open;
70 yamat0jp 10 end;
71    
72 yamat0jp 12 procedure TAdminPage.IWButton1Click(Sender: TObject);
73     begin
74 yamat0jp 13 if DM.FDTable5.MasterSource = DM.order then
75     DM.FDTable5.MasterSource := nil
76     else
77     DM.FDTable5.MasterSource := DM.order;
78 yamat0jp 12 end;
79    
80     procedure TAdminPage.IWButton4Click(Sender: TObject);
81     begin
82     Release;
83     end;
84    
85 yamat0jp 13 procedure TAdminPage.IWButton5Click(Sender: TObject);
86     var
87     x: Boolean;
88     begin
89     DM.FDTable5.MasterSource := DM.order;
90     DM.FDTable6.First;
91     while DM.FDTable6.Eof = false do
92     begin
93     DM.FDTable5.First;
94     x := true;
95     while DM.FDTable5.Eof = false do
96     begin
97     if DM.FDTable5.FieldByName('CHECKVALUE').AsBoolean = false then
98     begin
99     x := false;
100     break;
101     end;
102     DM.FDTable5.Next;
103     end;
104     if x = true then
105     begin
106     DM.FDTable5.First;
107     while DM.FDTable5.Eof = false do
108     DM.FDTable5.Delete;
109     DM.FDTable4.Delete;
110     DM.FDTable6.Delete;
111     end
112     else
113     DM.FDTable6.Next;
114     end;
115 yamat0jp 14 DM.FDTable6.First;
116     FDQuery1.Close;
117     FDQuery1.Open;
118     FDQuery1AfterScroll(nil);
119 yamat0jp 13 end;
120    
121 yamat0jp 17 procedure TAdminPage.IWCheckBox1Change(Sender: TObject);
122     begin
123     with Sender as TIWCheckBox do
124     begin
125     Checked := true;
126     if DM.FDTable5.Locate('KEYFIELD', Tag) = true then
127     begin
128     DM.FDTable5.Edit;
129     DM.FDTable5.FieldByName('CHECKVALUE').AsBoolean := true;
130     DM.FDTable5.Post;
131     end;
132     end;
133     end;
134    
135     procedure TAdminPage.IWDBGrid2Render(Sender: TObject);
136     begin
137     dummy.Free;
138     dummy := TComponent.Create(IWDBGrid2);
139     DM.FDTable5.First;
140     end;
141    
142     procedure TAdminPage.IWDBGrid2RenderCell(ACell: TIWGridCell;
143     const ARow, AColumn: Integer);
144     var
145     s: TIWCheckBox;
146     begin
147     if (ARow > 0) and (AColumn = 4) then
148     begin
149     s := TIWCheckBox.Create(dummy);
150     s.Tag := DM.FDTable5.FieldByName('KEYFIELD').AsInteger;
151     s.Checked := DM.FDTable5.FieldByName('CHECKVALUE').AsBoolean;
152     s.OnChange := IWCheckBox1Change;
153     s.Caption := s.Tag.ToString;
154     ACell.Control := s;
155     end;
156     end;
157    
158 yamat0jp 14 procedure TAdminPage.IWDBNavigator1First(Sender: TObject);
159 yamat0jp 12 begin
160 yamat0jp 17 DM.FDTable6.First;
161 yamat0jp 12 end;
162    
163 yamat0jp 14 procedure TAdminPage.IWDBNavigator1Last(Sender: TObject);
164 yamat0jp 10 begin
165 yamat0jp 14 DM.FDTable6.Last;
166 yamat0jp 10 end;
167    
168 yamat0jp 14 procedure TAdminPage.IWDBNavigator1Next(Sender: TObject);
169     begin
170     DM.FDTable6.Next;
171     end;
172    
173     procedure TAdminPage.IWDBNavigator1Prior(Sender: TObject);
174     begin
175     DM.FDTable6.Prior;
176     end;
177    
178 yamat0jp 1 end.

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