Statistiques
| Révision:

root / UnitFeedsList.pas

Historique | Voir | Annoter | Télécharger (14,686 ko)

1 1 avalancogn
unit UnitFeedsList;
2
3
interface
4
5
uses
6
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7
  Dialogs, gnugettext, StdCtrls, ComCtrls, ExtCtrls, DB, DBGrids, Grids,
8
  Buttons, pngimage, ActnList, ToolWin, ImgList, JvExStdCtrls, JvButton, JvCtrls;
9
10
type
11
  TFormFeedsList = class(TForm)
12
    PageControlLists: TPageControl;
13
    TabSheetProximal: TTabSheet;
14
    DBGridProximal: TDBGrid;
15
    TabSheetEnergyUtilization: TTabSheet;
16
    DBGridRatios: TDBGrid;
17
    TabSheetEnergy: TTabSheet;
18
    DBGridEnergy: TDBGrid;
19
    TabSheetAATot: TTabSheet;
20
    DBGridAATot: TDBGrid;
21
    TabSheetAADig: TTabSheet;
22
    DBGridAADig: TDBGrid;
23
    TabSheetMinerals: TTabSheet;
24
    DBGridMinerals: TDBGrid;
25
    TabSheetMS: TTabSheet;
26
    DBGridMS: TDBGrid;
27
    PanelButtons: TPanel;
28
    PanelName: TPanel;
29
    SplitterList: TSplitter;
30
    DBGridName: TDBGrid;
31
    ImageListIcons: TImageList;
32
    ActionListButtons: TActionList;
33
    ActionView: TAction;
34
    ActionCreate: TAction;
35
    ActionGraphs: TAction;
36
    ActionEval: TAction;
37
    ActionHelp: TAction;
38
    ActionClose: TAction;
39
    JvImgBtnClose: TJvImgBtn;
40
    JvImgBtnHelp: TJvImgBtn;
41
    JvImgBtnCreate: TJvImgBtn;
42
    JvImgBtnView: TJvImgBtn;
43
    JvImgBtnEval: TJvImgBtn;
44
    JvImgBtnGraphs: TJvImgBtn;
45 5 avalancogn
    TabSheetBE: TTabSheet;
46
    DBGridBE: TDBGrid;
47 1 avalancogn
    procedure FormCreate(Sender: TObject);
48
    procedure DBGridFeedsDrawColumnCell(Sender: TObject; const Rect: TRect;
49
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
50
    procedure DBGridFeedsTitleClick(Column: TColumn);
51
    procedure DBGridFeedsDblClick(Sender: TObject);
52
    procedure FormShow(Sender: TObject);
53
    procedure PageControlListsChange(Sender: TObject);
54
    procedure FormResize(Sender: TObject);
55
    procedure SplitterListMoved(Sender: TObject);
56
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
57
    procedure ActionViewExecute(Sender: TObject);
58
    procedure ActionCreateExecute(Sender: TObject);
59
    procedure ActionGraphsExecute(Sender: TObject);
60
    procedure ActionEvalExecute(Sender: TObject);
61
    procedure ActionHelpExecute(Sender: TObject);
62
    procedure ActionCloseExecute(Sender: TObject);
63
  private
64
    { D?clarations priv?es }
65
    DBGridNameOldWindowProc: TWndMethod;
66
    DBGridMSOldWindowProc: TWndMethod;
67
    DBGridProximalOldWindowProc: TWndMethod;
68
    DBGridRatiosOldWindowProc: TWndMethod;
69
    DBGridEnergyOldWindowProc: TWndMethod;
70
    DBGridAATotOldWindowProc: TWndMethod;
71
    DBGridAADigOldWindowProc: TWndMethod;
72
    DBGridMineralsOldWindowProc: TWndMethod;
73
    Procedure DBGridNameNewWindowProc(var Msg: TMessage);
74
    Procedure DBGridMSNewWindowProc(var Msg: TMessage);
75
    Procedure DBGridProximalNewWindowProc(var Msg: TMessage);
76
    Procedure DBGridRatiosNewWindowProc(var Msg: TMessage);
77
    Procedure DBGridEnergyNewWindowProc(var Msg: TMessage);
78
    Procedure DBGridAATotNewWindowProc(var Msg: TMessage);
79
    Procedure DBGridAADigNewWindowProc(var Msg: TMessage);
80
    Procedure DBGridMineralsNewWindowProc(var Msg: TMessage);
81
  public
82
    { D?clarations publiques }
83
  end;
84
85
var
86
  FormFeedsList: TFormFeedsList;
87
88
implementation
89
90
uses
91
  UnitDeclaration, UnitOptions, UnitFeedCreation, UnitFeedDetail,
92
  UnitFeedsCharts, UnitPredictionCreate;
93
94
{$R *.dfm}
95
96
procedure TFormFeedsList.ActionCloseExecute(Sender: TObject);
97
begin
98
  ModalResult := mrClose;
99
end;
100
101
procedure TFormFeedsList.ActionCreateExecute(Sender: TObject);
102
begin
103
  FormFeedCreation := TFormFeedCreation.Create(nil);
104
  try
105
    if FormFeedCreation.ShowModal = mrOk
106
    then
107
    begin
108
      FormFeedDetail := TFormFeedDetail.Create(nil);
109
      try
110
        // Modifier le nouvel enregistrement
111
        FormFeedDetail.ActionModifyExecute(Sender);
112
        FormFeedDetail.ShowModal;
113
      finally
114
        FormFeedDetail.Release;
115
      end;
116
    end;
117
  finally
118
    FormFeedCreation.Release;
119
  end;
120
end;
121
122
procedure TFormFeedsList.ActionEvalExecute(Sender: TObject);
123
begin
124
  FormPredictionCreate := TFormPredictionCreate.Create(nil);
125
  try
126
    FormPredictionCreate.ShowModal;
127
  finally
128
    FormPredictionCreate.Release;
129
  end;
130
end;
131
132
procedure TFormFeedsList.ActionGraphsExecute(Sender: TObject);
133
begin
134
  FormFeedsCharts := TFormFeedsCharts.Create(nil);
135
  try
136
    FormFeedsCharts.ShowModal;
137
  finally
138
    FormFeedsCharts.Release;
139
  end;
140
end;
141
142
procedure TFormFeedsList.ActionHelpExecute(Sender: TObject);
143
begin
144
  Application.HelpContext(HelpContext);
145
end;
146
147
procedure TFormFeedsList.ActionViewExecute(Sender: TObject);
148
begin
149
  if DataModuleDeclaration.ClientDataSetFeeds.IsEmpty
150
  then // Table aliment vide
151
    Exit;
152
  FormFeedDetail := TFormFeedDetail.Create(nil);
153
  try
154
    FormFeedDetail.ShowModal;
155
  finally
156
    FormFeedDetail.Release;
157
  end;
158
end;
159
160
procedure TFormFeedsList.DBGridFeedsDblClick(Sender: TObject);
161
begin
162
//  ButtonViewClick(nil);
163
  ActionViewExecute(nil);
164
end;
165
166
procedure TFormFeedsList.DBGridFeedsDrawColumnCell(Sender: TObject;
167
  const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
168
begin
169
  with Sender as TDBGrid do
170
  begin
171
    if Column.FieldName = DataModuleDeclaration.ClientDataSetFeeds.IndexFieldNames
172
    then // Colonne tri?e
173
      Canvas.Font.Style := Canvas.Font.Style + [fsBold];
174
    {
175
    if gdSelected in State
176
    then // Cellule courante
177
    begin
178
      Canvas.Font.Color := clWebWhite;
179
      Canvas.Brush.Color := clWebGray;
180
    end
181
    else
182
    begin
183
      Canvas.Font.Color := clWebBlack;
184
      Canvas.Brush.Color := clWebLightGrey;
185
    end;
186
    }
187
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
188
  end;
189
end;
190
191
procedure TFormFeedsList.DBGridNameNewWindowProc(var Msg: TMessage);
192
begin
193
  if Msg.Msg = WM_MOUSEWHEEL
194
  then // Interception de l'?v?nement WM_MOUSEWHEEL
195
    if SmallInt(Msg.WParamHi) < 0
196
    then
197
      DataModuleDeclaration.ClientDataSetFeeds.Next
198
    else
199
      DataModuleDeclaration.ClientDataSetFeeds.Prior
200
  else // Traitement des autres messages
201
  begin
202
    if Msg.Msg = WM_NCCALCSIZE
203
    then // Forcer l'affichage des ascenseurs
204
      ShowScrollBar(DBGridName.Handle, SB_BOTH, True);
205
    DBGridNameOldWindowProc(Msg);
206
  end;
207
end;
208
209
procedure TFormFeedsList.DBGridMSNewWindowProc(var Msg: TMessage);
210
begin
211
  if Msg.Msg = WM_MOUSEWHEEL
212
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
213
    if SmallInt(Msg.WParamHi) < 0
214
    then
215
      DataModuleDeclaration.ClientDataSetFeeds.Next
216
    else
217
      DataModuleDeclaration.ClientDataSetFeeds.Prior
218
  else // Traitement des autres messages
219
  begin
220
    if Msg.Msg = WM_NCCALCSIZE
221
    then // Forcer l'affichage des ascenseurs
222
      ShowScrollBar(DBGridMS.Handle, SB_BOTH, True);
223
    DBGridMSOldWindowProc(Msg);
224
  end;
225
end;
226
227
procedure TFormFeedsList.DBGridProximalNewWindowProc(var Msg: TMessage);
228
begin
229
  if Msg.Msg = WM_MOUSEWHEEL
230
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
231
    if SmallInt(Msg.WParamHi) < 0
232
    then
233
      DataModuleDeclaration.ClientDataSetFeeds.Next
234
    else
235
      DataModuleDeclaration.ClientDataSetFeeds.Prior
236
  else // Traitement des autres messages
237
  begin
238
    if Msg.Msg = WM_NCCALCSIZE
239
    then // Forcer l'affichage des ascenseurs
240
      ShowScrollBar(DBGridProximal.Handle, SB_BOTH, True);
241
    DBGridProximalOldWindowProc(Msg);
242
  end;
243
end;
244
245
procedure TFormFeedsList.DBGridRatiosNewWindowProc(var Msg: TMessage);
246
begin
247
  if Msg.Msg = WM_MOUSEWHEEL
248
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
249
    if SmallInt(Msg.WParamHi) < 0
250
    then
251
      DataModuleDeclaration.ClientDataSetFeeds.Next
252
    else
253
      DataModuleDeclaration.ClientDataSetFeeds.Prior
254
  else // Traitement des autres messages
255
  begin
256
    if Msg.Msg = WM_NCCALCSIZE
257
    then // Forcer l'affichage des ascenseurs
258
      ShowScrollBar(DBGridRatios.Handle, SB_BOTH, True);
259
    DBGridRatiosOldWindowProc(Msg);
260
  end;
261
end;
262
263
procedure TFormFeedsList.DBGridEnergyNewWindowProc(var Msg: TMessage);
264
begin
265
  if Msg.Msg = WM_MOUSEWHEEL
266
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
267
    if SmallInt(Msg.WParamHi) < 0
268
    then
269
      DataModuleDeclaration.ClientDataSetFeeds.Next
270
    else
271
      DataModuleDeclaration.ClientDataSetFeeds.Prior
272
  else // Traitement des autres messages
273
  begin
274
    if Msg.Msg = WM_NCCALCSIZE
275
    then // Forcer l'affichage des ascenseurs
276
      ShowScrollBar(DBGridEnergy.Handle, SB_BOTH, True);
277
    DBGridEnergyOldWindowProc(Msg);
278
  end;
279
end;
280
281
procedure TFormFeedsList.DBGridAATotNewWindowProc(var Msg: TMessage);
282
begin
283
  if Msg.Msg = WM_MOUSEWHEEL
284
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
285
    if SmallInt(Msg.WParamHi) < 0
286
    then
287
      DataModuleDeclaration.ClientDataSetFeeds.Next
288
    else
289
      DataModuleDeclaration.ClientDataSetFeeds.Prior
290
  else // Traitement des autres messages
291
  begin
292
    if Msg.Msg = WM_NCCALCSIZE
293
    then // Forcer l'affichage des ascenseurs
294
      ShowScrollBar(DBGridAATot.Handle, SB_BOTH, True);
295
    DBGridAATotOldWindowProc(Msg);
296
  end;
297
end;
298
299
procedure TFormFeedsList.DBGridAADigNewWindowProc(var Msg: TMessage);
300
begin
301
  if Msg.Msg = WM_MOUSEWHEEL
302
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
303
    if SmallInt(Msg.WParamHi) < 0
304
    then
305
      DataModuleDeclaration.ClientDataSetFeeds.Next
306
    else
307
      DataModuleDeclaration.ClientDataSetFeeds.Prior
308
  else // Traitement des autres messages
309
  begin
310
    if Msg.Msg = WM_NCCALCSIZE
311
    then // Forcer l'affichage des ascenseurs
312
      ShowScrollBar(DBGridAADig.Handle, SB_BOTH, True);
313
    DBGridAADigOldWindowProc(Msg);
314
  end;
315
end;
316
317
procedure TFormFeedsList.DBGridMineralsNewWindowProc(var Msg: TMessage);
318
begin
319
  if Msg.Msg = WM_MOUSEWHEEL
320
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
321
    if SmallInt(Msg.WParamHi) < 0
322
    then
323
      DataModuleDeclaration.ClientDataSetFeeds.Next
324
    else
325
      DataModuleDeclaration.ClientDataSetFeeds.Prior
326
  else // Traitement des autres messages
327
  begin
328
    if Msg.Msg = WM_NCCALCSIZE
329
    then // Forcer l'affichage des ascenseurs
330
      ShowScrollBar(DBGridMinerals.Handle, SB_BOTH, True);
331
    DBGridMineralsOldWindowProc(Msg);
332
  end;
333
end;
334
335
procedure TFormFeedsList.DBGridFeedsTitleClick(Column: TColumn);
336
begin
337
  with DataModuleDeclaration.ClientDataSetFeeds do
338
    if IndexFieldNames = Column.FieldName
339
    then // C'est d?j? l'index => tri selon le num?ro
340
      IndexFieldNames := ''
341
    else
342
      IndexFieldNames := Column.FieldName;
343
end;
344
345
procedure TFormFeedsList.FormCreate(Sender: TObject);
346
var
347
  ProximalUnit, EnergyUnit, AAUnit, MineralsUnit: String;
348
begin
349
  if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1
350
  then
351
    Font.Name := 'Arial Unicode MS';
352
//  PanelButtons.Font.Size := PanelButtons.Font.Size + 2;
353
  PanelButtons.Font.Style := [fsBold];
354
  TranslateComponent(Self);
355
  with FormOptions do
356
    if Expression = 0
357
    then // sur frais
358
    begin
359
      ProximalUnit := ComboBoxProximal.Items[Proximal];
360
      EnergyUnit := ComboBoxEnergy.Items[Energy];
361
      AAUnit := ComboBoxAA.Items[AA];
362
      MineralsUnit := ComboBoxMinerals.Items[Minerals];
363
    end
364
    else // sur mati?re s?che
365
    begin
366
      ProximalUnit := Format('%s %s', [ComboBoxProximal.Items[Proximal], _('DM')]);
367
      EnergyUnit := Format('%s %s', [ComboBoxEnergy.Items[Energy], _('DM')]);
368
      AAUnit := Format('%s %s', [ComboBoxAA.Items[AA], _('DM')]);
369
      MineralsUnit := Format('%s %s', [ComboBoxMinerals.Items[Minerals], _('DM')]);
370
    end;
371
  with FormOptions do
372 5 avalancogn
    TabSheetMS.Caption := Format('%s (%s)', [TabSheetMS.Caption, ComboBoxProximal.Items[Proximal]]);
373
  TabSheetProximal.Caption := Format('%s (%s)', [TabSheetProximal.Caption, ProximalUnit]);
374
  TabSheetEnergy.Caption := Format('%s (%s)', [TabSheetEnergy.Caption, EnergyUnit]);
375
  TabSheetEnergyUtilization.Caption := Format('%s (%%)', [TabSheetEnergyUtilization.Caption]);
376
  TabSheetAATot.Caption := Format('%s (%s)', [TabSheetAATot.Caption, AAUnit]);
377
  TabSheetAADig.Caption := Format('%s (%s)', [TabSheetAADig.Caption, AAUnit]);
378
  TabSheetMinerals.Caption := Format('%s (%s)', [TabSheetMinerals.Caption, MineralsUnit]);
379
  if FormOptions.Expression = 0
380
  then // sur frais
381
    TabSheetBE.Caption := Format('%s (%s)', [TabSheetBE.Caption, _('mEq/kg')])
382
  else // sur mati?re s?che
383
    TabSheetBE.Caption := Format('%s (%s %s)', [TabSheetBE.Caption, _('mEq/kg'), _('DM')]);
384 1 avalancogn
  // Sauvegarder la WndProc actuelle du DBGrid
385
  DBGridNameOldWindowProc := DBGridName.WindowProc;
386
  DBGridMSOldWindowProc := DBGridMS.WindowProc;
387
  DBGridProximalOldWindowProc := DBGridProximal.WindowProc;
388
  DBGridRatiosOldWindowProc := DBGridRatios.WindowProc;
389
  DBGridEnergyOldWindowProc := DBGridEnergy.WindowProc;
390
  DBGridAATotOldWindowProc := DBGridAATot.WindowProc;
391
  DBGridAADigOldWindowProc := DBGridAADig.WindowProc;
392
  DBGridMineralsOldWindowProc := DBGridMinerals.WindowProc;
393
  // Affecter une nouvelle proc?dure de fen?tre
394
  DBGridName.WindowProc := DBGridNameNewWindowProc;
395
  DBGridMS.WindowProc := DBGridMSNewWindowProc;
396
  DBGridProximal.WindowProc := DBGridProximalNewWindowProc;
397
  DBGridRatios.WindowProc := DBGridRatiosNewWindowProc;
398
  DBGridEnergy.WindowProc := DBGridEnergyNewWindowProc;
399
  DBGridAATot.WindowProc := DBGridAATotNewWindowProc;
400
  DBGridAADig.WindowProc := DBGridAADigNewWindowProc;
401
  DBGridMinerals.WindowProc := DBGridMineralsNewWindowProc;
402
end;
403
404
procedure TFormFeedsList.FormResize(Sender: TObject);
405
begin
406
  // Adaptater la position et la taille de la liste des noms
407
  DBGridName.Top := TabSheetMS.Top;
408
  case PageControlLists.ActivePageIndex of
409
    0: DBGridName.Height := DBGridMS.Height;
410
    1: DBGridName.Height := DBGridProximal.Height;
411
    2: DBGridName.Height := DBGridRatios.Height;
412
    3: DBGridName.Height := DBGridEnergy.Height;
413
    4: DBGridName.Height := DBGridAATot.Height;
414
    5: DBGridName.Height := DBGridAADig.Height;
415
    6: DBGridName.Height := DBGridMinerals.Height;
416
  end;
417
end;
418
419
procedure TFormFeedsList.FormShow(Sender: TObject);
420
begin
421
  with DataModuleDeclaration do
422
//    ClientDataSetFeeds.Last;
423
    ClientDataSetFeeds.First;
424
  PageControlLists.ActivePageIndex := 0;
425
  PageControlListsChange(nil);
426
end;
427
428
procedure TFormFeedsList.PageControlListsChange(Sender: TObject);
429
begin
430
  FormResize(nil);
431
  // Activer la liste de l'onglet s?lectionn?
432
  case PageControlLists.ActivePageIndex of
433
    0: ActiveControl := DBGridMS;
434
    1: ActiveControl := DBGridProximal;
435
    2: ActiveControl := DBGridRatios;
436
    3: ActiveControl := DBGridEnergy;
437
    4: ActiveControl := DBGridAATot;
438
    5: ActiveControl := DBGridAADig;
439
    6: ActiveControl := DBGridMinerals;
440
  end;
441
end;
442
443
procedure TFormFeedsList.SplitterListMoved(Sender: TObject);
444
begin
445
  FormResize(nil);
446
end;
447
448
procedure TFormFeedsList.WMSysCommand(var Message: TWMSysCommand);
449
begin
450
  if Message.CmdType = SC_MINIMIZE
451
  then
452
    Application.Minimize
453
  else
454
    inherited;
455
end;
456
457
end.