root / UnitFeedCreation.pas
Historique | Voir | Annoter | Télécharger (10,981 ko)
1 |
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.
|