root / UnitFeedCreation.pas
Historique | Voir | Annoter | Télécharger (10,981 ko)
1 | 1 | avalancogn | unit UnitFeedCreation;
|
---|---|---|---|
2 | |||
3 | interface
|
||
4 | |||
5 | uses
|
||
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
||
7 | Dialogs, gnugettext, StdCtrls, Grids, DBGrids, DB, ImgList, ActnList, |
||
8 | JvExStdCtrls, JvButton, JvCtrls, ExtCtrls; |
||
9 | |||
10 | type
|
||
11 | TFormFeedCreation = class(TForm)
|
||
12 | CheckBoxModel: TCheckBox; |
||
13 | LabelName: TLabel; |
||
14 | LabelDescription: TLabel; |
||
15 | ComboBoxModel: TComboBox; |
||
16 | EditName: TEdit; |
||
17 | MemoDescription: TMemo; |
||
18 | JvImgBtnCancel: TJvImgBtn; |
||
19 | JvImgBtnOK: TJvImgBtn; |
||
20 | JvImgBtnHelp: TJvImgBtn; |
||
21 | ActionListButtons: TActionList; |
||
22 | ActionHelp: TAction; |
||
23 | ActionOK: TAction; |
||
24 | ActionCancel: TAction; |
||
25 | ImageListIcons: TImageList; |
||
26 | PanelButtons: TPanel; |
||
27 | procedure FormCreate(Sender: TObject);
|
||
28 | procedure CheckBoxModelClick(Sender: TObject);
|
||
29 | procedure ActionHelpExecute(Sender: TObject);
|
||
30 | procedure ActionOKExecute(Sender: TObject);
|
||
31 | procedure ActionCancelExecute(Sender: TObject);
|
||
32 | private
|
||
33 | { D?clarations priv?es }
|
||
34 | public
|
||
35 | { D?clarations publiques }
|
||
36 | end;
|
||
37 | |||
38 | var
|
||
39 | FormFeedCreation: TFormFeedCreation; |
||
40 | |||
41 | implementation
|
||
42 | |||
43 | {$R *.dfm}
|
||
44 | |||
45 | uses
|
||
46 | UnitDeclaration, UnitOptions; |
||
47 | |||
48 | procedure TFormFeedCreation.ActionCancelExecute(Sender: TObject);
|
||
49 | begin
|
||
50 | ModalResult := mrCancel; |
||
51 | end;
|
||
52 | |||
53 | procedure TFormFeedCreation.ActionHelpExecute(Sender: TObject);
|
||
54 | begin
|
||
55 | Application.HelpContext(HelpContext); |
||
56 | end;
|
||
57 | |||
58 | procedure TFormFeedCreation.ActionOKExecute(Sender: TObject);
|
||
59 | var
|
||
60 | NewId, ModelId: Integer; |
||
61 | NewName, NewComment: String;
|
||
62 | USFormatSettings: TFormatSettings; |
||
63 | begin
|
||
64 | NewName := Trim(EditName.Text); |
||
65 | NewComment := MemoDescription.Text; |
||
66 | if NewName = '' |
||
67 | then
|
||
68 | begin
|
||
69 | MessageDlg(_('You must specify a name for this diet.'), mtError, [mbOK], 0); |
||
70 | ActiveControl := EditName; |
||
71 | Exit; |
||
72 | end;
|
||
73 | if DataModuleDeclaration.FeedList.IndexOf(NewName) <> -1 |
||
74 | then
|
||
75 | begin
|
||
76 | MessageDlg(_('This name is already used, please specify another name.'), mtError, [mbOK], 0); |
||
77 | ActiveControl := EditName; |
||
78 | Exit; |
||
79 | end;
|
||
80 | if CheckBoxModel.Checked and (ComboBoxModel.ItemIndex = -1) |
||
81 | then
|
||
82 | begin
|
||
83 | MessageDlg(_('You must specify a template for this feed.'), mtError, [mbOK], 0); |
||
84 | ActiveControl := ComboBoxModel; |
||
85 | Exit; |
||
86 | end;
|
||
87 | with DataModuleDeclaration do |
||
88 | begin
|
||
89 | // Rechercher une valeur pour le champs Id
|
||
90 | TableFeeds := DBUser.GetTable('SELECT Id FROM Feeds ORDER BY Id');
|
||
91 | with TableFeeds do |
||
92 | try
|
||
93 | if RowCount > 0 |
||
94 | then
|
||
95 | begin
|
||
96 | MoveLast; |
||
97 | NewId := FieldAsInteger(FieldIndex['Id']) + 1; |
||
98 | end
|
||
99 | else
|
||
100 | NewId := 1;
|
||
101 | finally
|
||
102 | Free; |
||
103 | end;
|
||
104 | // Cr?er le nouveau r?gime
|
||
105 | GetLocaleFormatSettings(1033, USFormatSettings);
|
||
106 | DBUser.BeginTransaction; |
||
107 | try
|
||
108 | if CheckBoxModel.Checked
|
||
109 | then // Copier les informations du mod?le |
||
110 | begin
|
||
111 | ClientDataSetFeeds.Locate('Name', ComboBoxModel.Text, []);
|
||
112 | //ClientDataSetFeeds.RecNo := FeedList.IndexOf(ComboBoxModel.Text) + 1;
|
||
113 | ModelId := ClientDataSetFeedsId.Value; |
||
114 | DBUser.ExecSQL('INSERT INTO Feeds (Id, Name, Description, Presentation, BonusC, BonusT) VALUES ('
|
||
115 | + Format('%d, ', [NewId])
|
||
116 | + Format('%s, ', [QuotedStr(NewName)])
|
||
117 | + Format('%s, ', [QuotedStr(NewComment)])
|
||
118 | + Format('%d, ', [ClientDataSetFeedsPresentation.Value])
|
||
119 | + Format('%.3f, ', [ClientDataSetFeedsBonusC.Value / 100], USFormatSettings) |
||
120 | + Format('%.3f)', [ClientDataSetFeedsBonusT.Value / 100], USFormatSettings)); |
||
121 | if not ClientDataSetFeedsPhytaseId.IsNull |
||
122 | then
|
||
123 | DBUser.ExecSQL('UPDATE Feeds '
|
||
124 | + Format('SET Phytase = %d ', [ClientDataSetFeedsPhytaseId.Value])
|
||
125 | + Format('WHERE Id = %d', [NewId]));
|
||
126 | if not ClientDataSetFeedsPhytaseConcentration.IsNull |
||
127 | then
|
||
128 | DBUser.ExecSQL('UPDATE Feeds '
|
||
129 | + Format('SET Concentration = %.0f ', [ClientDataSetFeedsPhytaseConcentration.Value], USFormatSettings)
|
||
130 | + Format('WHERE Id = %d', [NewId]));
|
||
131 | if not ClientDataSetFeedsPhytaseIncorporation.IsNull |
||
132 | then
|
||
133 | DBUser.ExecSQL('UPDATE Feeds '
|
||
134 | + Format('SET Incorporation = %.0f ', [ClientDataSetFeedsPhytaseIncorporation.Value], USFormatSettings)
|
||
135 | + Format('WHERE Id = %d', [NewId]));
|
||
136 | end
|
||
137 | else
|
||
138 | DBUser.ExecSQL('INSERT INTO Feeds (Id, Name, Description, Presentation, BonusC, BonusT) VALUES ('
|
||
139 | + Format('%d, ', [NewId])
|
||
140 | + Format('%s, ', [QuotedStr(NewName)])
|
||
141 | + Format('%s, ', [QuotedStr(NewComment)])
|
||
142 | + '0, '
|
||
143 | + '0, '
|
||
144 | + '0)');
|
||
145 | DBUser.Commit; |
||
146 | except
|
||
147 | DBUser.RollBack; |
||
148 | MessageDlg(Format(_('Unknown error: %s %s %s'), ['UnitFeedCreation', 'ActionOKExecute', 'DBUser (INSERT INTO Feeds / UPDATE Feeds)']), mtError, [mbOK], 0); |
||
149 | Exit; |
||
150 | end;
|
||
151 | if CheckBoxModel.Checked
|
||
152 | then // Copier la composition du mod?le |
||
153 | begin
|
||
154 | ClientDataSetComposition.Filter := Format('Feed = %d', [ModelId]);
|
||
155 | ClientDataSetComposition.Filtered := True; |
||
156 | DBUser.BeginTransaction; |
||
157 | try
|
||
158 | ClientDataSetComposition.First; |
||
159 | while not ClientDataSetComposition.Eof do |
||
160 | begin
|
||
161 | ClientDataSetCompositionUser.DisplayValues := DefaultTrueBoolStr + ';' + DefaultFalseBoolStr;
|
||
162 | DBUser.ExecSQL('INSERT INTO Composition (Feed, Ingredient, User, Rank, MS, Level) VALUES ('
|
||
163 | + Format('%d, ', [NewId])
|
||
164 | + Format('%d, ', [ClientDataSetCompositionIngredient.Value])
|
||
165 | + Format('''%s'', ', [ClientDataSetCompositionUser.AsString])
|
||
166 | + Format('%d, ', [ClientDataSetCompositionRank.Value])
|
||
167 | + Format('%.15f, ', [InputProximal(ClientDataSetCompositionMS.Value, 1, 1, FormOptions.Proximal)], USFormatSettings) |
||
168 | + Format('%.15f)', [InputIncorporation(ClientDataSetCompositionLevel.Value, FormOptions.Incorporation)], USFormatSettings));
|
||
169 | ClientDataSetComposition.Next; |
||
170 | end;
|
||
171 | DBUser.Commit; |
||
172 | except
|
||
173 | DBUser.RollBack; |
||
174 | MessageDlg(Format(_('Unknown error: %s %s %s'), ['UnitFeedCreation', 'ActionOKExecute', 'DBUser (INSERT INTO Composition)']), mtError, [mbOK], 0); |
||
175 | Exit; |
||
176 | end;
|
||
177 | ClientDataSetComposition.Filtered := False; |
||
178 | ClientDataSetComposition.Filter := '';
|
||
179 | // R?percuter dans ClientDataSetComposition
|
||
180 | Application.ProcessMessages; |
||
181 | TableComposition := DBUser.GetTable('SELECT * FROM Composition '
|
||
182 | + Format('WHERE Feed = %d', [NewId]));
|
||
183 | while not TableComposition.Eof do |
||
184 | begin
|
||
185 | ClientDataSetComposition.Append; |
||
186 | try
|
||
187 | ClientDataSetCompositionFeed.Value := NewId; |
||
188 | ClientDataSetCompositionIngredient.Value := TableComposition.FieldAsInteger(TableComposition.FieldIndex['Ingredient']);
|
||
189 | ClientDataSetCompositionUser.Value := (TableComposition.FieldAsString(TableComposition.FieldIndex['User']) = DefaultTrueBoolStr);
|
||
190 | if ClientDataSetCompositionUser.Value
|
||
191 | then
|
||
192 | ClientDataSetIngredients.Filter := Format('Id = %d and User', [ClientDataSetCompositionIngredient.Value])
|
||
193 | else
|
||
194 | ClientDataSetIngredients.Filter := Format('Id = %d and not User', [ClientDataSetCompositionIngredient.Value]);
|
||
195 | ClientDataSetIngredients.Filtered := True; |
||
196 | ClientDataSetCompositionIngredientName.Value := ClientDataSetIngredientsName.Value; |
||
197 | ClientDataSetIngredients.Filtered := False; |
||
198 | ClientDataSetIngredients.Filter := '';
|
||
199 | ClientDataSetCompositionRank.Value := TableComposition.FieldAsInteger(TableComposition.FieldIndex['Rank']);
|
||
200 | ClientDataSetCompositionMS.Value := OutputProximal(TableComposition.FieldAsDouble(TableComposition.FieldIndex['MS']), 1, 0, FormOptions.Proximal); |
||
201 | ClientDataSetCompositionLevel.Value := OutputIncorporation(TableComposition.FieldAsDouble(TableComposition.FieldIndex['Level']), FormOptions.Incorporation);
|
||
202 | ClientDataSetComposition.Post; |
||
203 | except
|
||
204 | ClientDataSetComposition.Cancel; |
||
205 | MessageDlg(Format(_('Unknown error: %s %s %s'), ['UnitFeedCreation', 'ActionOKExecute', 'ClientDataSetComposition']), mtError, [mbOK], 0); |
||
206 | Exit; |
||
207 | end;
|
||
208 | TableComposition.Next; |
||
209 | end;
|
||
210 | TableComposition.Free; |
||
211 | end;
|
||
212 | // Ajouter dans ClientDataSetFeeds
|
||
213 | Application.ProcessMessages; |
||
214 | TableFeeds := DBUser.GetTable('SELECT * FROM Feeds '
|
||
215 | + Format('WHERE Id = %d', [NewId]));
|
||
216 | ClientDataSetComposition.Filter := Format('Feed = %d', [NewId]);
|
||
217 | ClientDataSetComposition.Filtered := True; |
||
218 | ClientDataSetFeeds.Append; |
||
219 | try
|
||
220 | ClientDataSetFeedsId.Value := NewId; |
||
221 | ClientDataSetFeedsName.Value := NewName; |
||
222 | ClientDataSetFeedsDescription.Value := NewComment; |
||
223 | ClientDataSetFeedsPresentation.Value := TableFeeds.FieldAsInteger(TableFeeds.FieldIndex['Presentation']);
|
||
224 | ClientDataSetFeedsBonusC.Value := TableFeeds.FieldAsDouble(TableFeeds.FieldIndex['BonusC']) * 100; |
||
225 | ClientDataSetFeedsBonusT.Value := TableFeeds.FieldAsDouble(TableFeeds.FieldIndex['BonusT']) * 100; |
||
226 | if not TableFeeds.FieldIsNull(TableFeeds.FieldIndex['Phytase']) |
||
227 | then
|
||
228 | ClientDataSetFeedsPhytaseId.Value := TableFeeds.FieldAsInteger(TableFeeds.FieldIndex['Phytase']);
|
||
229 | if not TableFeeds.FieldIsNull(TableFeeds.FieldIndex['Concentration']) |
||
230 | then
|
||
231 | ClientDataSetFeedsPhytaseConcentration.Value := TableFeeds.FieldAsDouble(TableFeeds.FieldIndex['Concentration']);
|
||
232 | if not TableFeeds.FieldIsNull(TableFeeds.FieldIndex['Incorporation']) |
||
233 | then
|
||
234 | ClientDataSetFeedsPhytaseIncorporation.Value := TableFeeds.FieldAsDouble(TableFeeds.FieldIndex['Incorporation']);
|
||
235 | CalcFeed; |
||
236 | ClientDataSetFeeds.Post; |
||
237 | except
|
||
238 | ClientDataSetFeeds.Cancel; |
||
239 | MessageDlg(Format(_('Unknown error: %s %s %s'), ['UnitFeedCreation', 'ActionOKExecute', 'ClientDataSetFeeds']), mtError, [mbOK], 0); |
||
240 | Exit; |
||
241 | end;
|
||
242 | ClientDataSetComposition.Filtered := False; |
||
243 | ClientDataSetComposition.Filter := '';
|
||
244 | TableFeeds.Free; |
||
245 | // Ajouter le nom dans la liste des aliments
|
||
246 | FeedList.Add(NewName); |
||
247 | end;
|
||
248 | ModalResult := mrOk; |
||
249 | end;
|
||
250 | |||
251 | procedure TFormFeedCreation.CheckBoxModelClick(Sender: TObject);
|
||
252 | begin
|
||
253 | ComboBoxModel.Enabled := CheckBoxModel.Checked; |
||
254 | end;
|
||
255 | |||
256 | procedure TFormFeedCreation.FormCreate(Sender: TObject);
|
||
257 | begin
|
||
258 | if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1 |
||
259 | then
|
||
260 | Font.Name := 'Arial Unicode MS';
|
||
261 | // PanelButtons.Font.Size := PanelButtons.Font.Size + 2;
|
||
262 | PanelButtons.Font.Style := [fsBold]; |
||
263 | LabelName.Font.Style := [fsBold]; |
||
264 | EditName.Font.Style := [fsBold]; |
||
265 | TranslateComponent(Self); |
||
266 | with DataModuleDeclaration do |
||
267 | if ClientDataSetFeeds.IsEmpty
|
||
268 | then // Table aliment vide |
||
269 | CheckBoxModel.Enabled := False |
||
270 | else
|
||
271 | begin
|
||
272 | ComboBoxModel.Items.Assign(FeedList); |
||
273 | ComboBoxModel.ItemIndex := ComboBoxModel.Items.IndexOf(ClientDataSetFeedsName.Value); |
||
274 | end;
|
||
275 | end;
|
||
276 | |||
277 | end. |