Statistiques
| Révision:

root / UnitFeedsList.pas @ 1

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

1
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
    procedure FormCreate(Sender: TObject);
46
    procedure DBGridFeedsDrawColumnCell(Sender: TObject; const Rect: TRect;
47
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
48
    procedure DBGridFeedsTitleClick(Column: TColumn);
49
    procedure DBGridFeedsDblClick(Sender: TObject);
50
    procedure FormShow(Sender: TObject);
51
    procedure PageControlListsChange(Sender: TObject);
52
    procedure FormResize(Sender: TObject);
53
    procedure SplitterListMoved(Sender: TObject);
54
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
55
    procedure ActionViewExecute(Sender: TObject);
56
    procedure ActionCreateExecute(Sender: TObject);
57
    procedure ActionGraphsExecute(Sender: TObject);
58
    procedure ActionEvalExecute(Sender: TObject);
59
    procedure ActionHelpExecute(Sender: TObject);
60
    procedure ActionCloseExecute(Sender: TObject);
61
  private
62
    { D?clarations priv?es }
63
    DBGridNameOldWindowProc: TWndMethod;
64
    DBGridMSOldWindowProc: TWndMethod;
65
    DBGridProximalOldWindowProc: TWndMethod;
66
    DBGridRatiosOldWindowProc: TWndMethod;
67
    DBGridEnergyOldWindowProc: TWndMethod;
68
    DBGridAATotOldWindowProc: TWndMethod;
69
    DBGridAADigOldWindowProc: TWndMethod;
70
    DBGridMineralsOldWindowProc: TWndMethod;
71
    Procedure DBGridNameNewWindowProc(var Msg: TMessage);
72
    Procedure DBGridMSNewWindowProc(var Msg: TMessage);
73
    Procedure DBGridProximalNewWindowProc(var Msg: TMessage);
74
    Procedure DBGridRatiosNewWindowProc(var Msg: TMessage);
75
    Procedure DBGridEnergyNewWindowProc(var Msg: TMessage);
76
    Procedure DBGridAATotNewWindowProc(var Msg: TMessage);
77
    Procedure DBGridAADigNewWindowProc(var Msg: TMessage);
78
    Procedure DBGridMineralsNewWindowProc(var Msg: TMessage);
79
  public
80
    { D?clarations publiques }
81
  end;
82

    
83
var
84
  FormFeedsList: TFormFeedsList;
85

    
86
implementation
87

    
88
uses
89
  UnitDeclaration, UnitOptions, UnitFeedCreation, UnitFeedDetail,
90
  UnitFeedsCharts, UnitPredictionCreate;
91

    
92
{$R *.dfm}
93

    
94
procedure TFormFeedsList.ActionCloseExecute(Sender: TObject);
95
begin
96
  ModalResult := mrClose;
97
end;
98

    
99
procedure TFormFeedsList.ActionCreateExecute(Sender: TObject);
100
begin
101
  FormFeedCreation := TFormFeedCreation.Create(nil);
102
  try
103
    if FormFeedCreation.ShowModal = mrOk
104
    then
105
    begin
106
      FormFeedDetail := TFormFeedDetail.Create(nil);
107
      try
108
        // Modifier le nouvel enregistrement
109
        FormFeedDetail.ActionModifyExecute(Sender);
110
        FormFeedDetail.ShowModal;
111
      finally
112
        FormFeedDetail.Release;
113
      end;
114
    end;
115
  finally
116
    FormFeedCreation.Release;
117
  end;
118
end;
119

    
120
procedure TFormFeedsList.ActionEvalExecute(Sender: TObject);
121
begin
122
  FormPredictionCreate := TFormPredictionCreate.Create(nil);
123
  try
124
    FormPredictionCreate.ShowModal;
125
  finally
126
    FormPredictionCreate.Release;
127
  end;
128
end;
129

    
130
procedure TFormFeedsList.ActionGraphsExecute(Sender: TObject);
131
begin
132
  FormFeedsCharts := TFormFeedsCharts.Create(nil);
133
  try
134
    FormFeedsCharts.ShowModal;
135
  finally
136
    FormFeedsCharts.Release;
137
  end;
138
end;
139

    
140
procedure TFormFeedsList.ActionHelpExecute(Sender: TObject);
141
begin
142
  Application.HelpContext(HelpContext);
143
end;
144

    
145
procedure TFormFeedsList.ActionViewExecute(Sender: TObject);
146
begin
147
  if DataModuleDeclaration.ClientDataSetFeeds.IsEmpty
148
  then // Table aliment vide
149
    Exit;
150
  FormFeedDetail := TFormFeedDetail.Create(nil);
151
  try
152
    FormFeedDetail.ShowModal;
153
  finally
154
    FormFeedDetail.Release;
155
  end;
156
end;
157

    
158
procedure TFormFeedsList.DBGridFeedsDblClick(Sender: TObject);
159
begin
160
//  ButtonViewClick(nil);
161
  ActionViewExecute(nil);
162
end;
163

    
164
procedure TFormFeedsList.DBGridFeedsDrawColumnCell(Sender: TObject;
165
  const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
166
begin
167
  with Sender as TDBGrid do
168
  begin
169
    if Column.FieldName = DataModuleDeclaration.ClientDataSetFeeds.IndexFieldNames
170
    then // Colonne tri?e
171
      Canvas.Font.Style := Canvas.Font.Style + [fsBold];
172
    {
173
    if gdSelected in State
174
    then // Cellule courante
175
    begin
176
      Canvas.Font.Color := clWebWhite;
177
      Canvas.Brush.Color := clWebGray;
178
    end
179
    else
180
    begin
181
      Canvas.Font.Color := clWebBlack;
182
      Canvas.Brush.Color := clWebLightGrey;
183
    end;
184
    }
185
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
186
  end;
187
end;
188

    
189
procedure TFormFeedsList.DBGridNameNewWindowProc(var Msg: TMessage);
190
begin
191
  if Msg.Msg = WM_MOUSEWHEEL
192
  then // Interception de l'?v?nement WM_MOUSEWHEEL
193
    if SmallInt(Msg.WParamHi) < 0
194
    then
195
      DataModuleDeclaration.ClientDataSetFeeds.Next
196
    else
197
      DataModuleDeclaration.ClientDataSetFeeds.Prior
198
  else // Traitement des autres messages
199
  begin 
200
    if Msg.Msg = WM_NCCALCSIZE
201
    then // Forcer l'affichage des ascenseurs
202
      ShowScrollBar(DBGridName.Handle, SB_BOTH, True);
203
    DBGridNameOldWindowProc(Msg);
204
  end;
205
end;
206

    
207
procedure TFormFeedsList.DBGridMSNewWindowProc(var Msg: TMessage);
208
begin
209
  if Msg.Msg = WM_MOUSEWHEEL
210
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
211
    if SmallInt(Msg.WParamHi) < 0
212
    then
213
      DataModuleDeclaration.ClientDataSetFeeds.Next
214
    else
215
      DataModuleDeclaration.ClientDataSetFeeds.Prior
216
  else // Traitement des autres messages
217
  begin 
218
    if Msg.Msg = WM_NCCALCSIZE
219
    then // Forcer l'affichage des ascenseurs
220
      ShowScrollBar(DBGridMS.Handle, SB_BOTH, True);
221
    DBGridMSOldWindowProc(Msg);
222
  end;
223
end;
224

    
225
procedure TFormFeedsList.DBGridProximalNewWindowProc(var Msg: TMessage);
226
begin
227
  if Msg.Msg = WM_MOUSEWHEEL
228
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
229
    if SmallInt(Msg.WParamHi) < 0
230
    then
231
      DataModuleDeclaration.ClientDataSetFeeds.Next
232
    else
233
      DataModuleDeclaration.ClientDataSetFeeds.Prior
234
  else // Traitement des autres messages
235
  begin 
236
    if Msg.Msg = WM_NCCALCSIZE
237
    then // Forcer l'affichage des ascenseurs
238
      ShowScrollBar(DBGridProximal.Handle, SB_BOTH, True);
239
    DBGridProximalOldWindowProc(Msg);
240
  end;
241
end;
242

    
243
procedure TFormFeedsList.DBGridRatiosNewWindowProc(var Msg: TMessage);
244
begin
245
  if Msg.Msg = WM_MOUSEWHEEL
246
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
247
    if SmallInt(Msg.WParamHi) < 0
248
    then
249
      DataModuleDeclaration.ClientDataSetFeeds.Next
250
    else
251
      DataModuleDeclaration.ClientDataSetFeeds.Prior
252
  else // Traitement des autres messages
253
  begin 
254
    if Msg.Msg = WM_NCCALCSIZE
255
    then // Forcer l'affichage des ascenseurs
256
      ShowScrollBar(DBGridRatios.Handle, SB_BOTH, True);
257
    DBGridRatiosOldWindowProc(Msg);
258
  end;
259
end;
260

    
261
procedure TFormFeedsList.DBGridEnergyNewWindowProc(var Msg: TMessage);
262
begin
263
  if Msg.Msg = WM_MOUSEWHEEL
264
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
265
    if SmallInt(Msg.WParamHi) < 0
266
    then
267
      DataModuleDeclaration.ClientDataSetFeeds.Next
268
    else
269
      DataModuleDeclaration.ClientDataSetFeeds.Prior
270
  else // Traitement des autres messages
271
  begin 
272
    if Msg.Msg = WM_NCCALCSIZE
273
    then // Forcer l'affichage des ascenseurs
274
      ShowScrollBar(DBGridEnergy.Handle, SB_BOTH, True);
275
    DBGridEnergyOldWindowProc(Msg);
276
  end;
277
end;
278

    
279
procedure TFormFeedsList.DBGridAATotNewWindowProc(var Msg: TMessage);
280
begin
281
  if Msg.Msg = WM_MOUSEWHEEL
282
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
283
    if SmallInt(Msg.WParamHi) < 0
284
    then
285
      DataModuleDeclaration.ClientDataSetFeeds.Next
286
    else
287
      DataModuleDeclaration.ClientDataSetFeeds.Prior
288
  else // Traitement des autres messages
289
  begin 
290
    if Msg.Msg = WM_NCCALCSIZE
291
    then // Forcer l'affichage des ascenseurs
292
      ShowScrollBar(DBGridAATot.Handle, SB_BOTH, True);
293
    DBGridAATotOldWindowProc(Msg);
294
  end;
295
end;
296

    
297
procedure TFormFeedsList.DBGridAADigNewWindowProc(var Msg: TMessage);
298
begin
299
  if Msg.Msg = WM_MOUSEWHEEL
300
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
301
    if SmallInt(Msg.WParamHi) < 0
302
    then
303
      DataModuleDeclaration.ClientDataSetFeeds.Next
304
    else
305
      DataModuleDeclaration.ClientDataSetFeeds.Prior
306
  else // Traitement des autres messages
307
  begin 
308
    if Msg.Msg = WM_NCCALCSIZE
309
    then // Forcer l'affichage des ascenseurs
310
      ShowScrollBar(DBGridAADig.Handle, SB_BOTH, True);
311
    DBGridAADigOldWindowProc(Msg);
312
  end;
313
end;
314

    
315
procedure TFormFeedsList.DBGridMineralsNewWindowProc(var Msg: TMessage);
316
begin
317
  if Msg.Msg = WM_MOUSEWHEEL
318
  then // Interception de l'?v?nement WM_MOUSEWHEEL.
319
    if SmallInt(Msg.WParamHi) < 0
320
    then
321
      DataModuleDeclaration.ClientDataSetFeeds.Next
322
    else
323
      DataModuleDeclaration.ClientDataSetFeeds.Prior
324
  else // Traitement des autres messages
325
  begin 
326
    if Msg.Msg = WM_NCCALCSIZE
327
    then // Forcer l'affichage des ascenseurs
328
      ShowScrollBar(DBGridMinerals.Handle, SB_BOTH, True);
329
    DBGridMineralsOldWindowProc(Msg);
330
  end;
331
end;
332

    
333
procedure TFormFeedsList.DBGridFeedsTitleClick(Column: TColumn);
334
begin
335
  with DataModuleDeclaration.ClientDataSetFeeds do
336
    if IndexFieldNames = Column.FieldName
337
    then // C'est d?j? l'index => tri selon le num?ro
338
      IndexFieldNames := ''
339
    else
340
      IndexFieldNames := Column.FieldName;
341
end;
342

    
343
procedure TFormFeedsList.FormCreate(Sender: TObject);
344
var
345
  ProximalUnit, EnergyUnit, AAUnit, MineralsUnit: String;
346
begin
347
  if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1
348
  then
349
    Font.Name := 'Arial Unicode MS';
350
//  PanelButtons.Font.Size := PanelButtons.Font.Size + 2;
351
  PanelButtons.Font.Style := [fsBold];
352
  TranslateComponent(Self);
353
  with FormOptions do
354
    if Expression = 0
355
    then // sur frais
356
    begin
357
      ProximalUnit := ComboBoxProximal.Items[Proximal];
358
      EnergyUnit := ComboBoxEnergy.Items[Energy];
359
      AAUnit := ComboBoxAA.Items[AA];
360
      MineralsUnit := ComboBoxMinerals.Items[Minerals];
361
    end
362
    else // sur mati?re s?che
363
    begin
364
      ProximalUnit := Format('%s %s', [ComboBoxProximal.Items[Proximal], _('DM')]);
365
      EnergyUnit := Format('%s %s', [ComboBoxEnergy.Items[Energy], _('DM')]);
366
      AAUnit := Format('%s %s', [ComboBoxAA.Items[AA], _('DM')]);
367
      MineralsUnit := Format('%s %s', [ComboBoxMinerals.Items[Minerals], _('DM')]);
368
    end;
369
  with FormOptions do
370
    TabSheetMS.Caption := TabSheetMS.Caption + Format(' (%s)', [ComboBoxProximal.Items[Proximal]]);
371
  TabSheetProximal.Caption := TabSheetProximal.Caption + Format(' (%s)', [ProximalUnit]);
372
  TabSheetEnergy.Caption := TabSheetEnergy.Caption + Format(' (%s)', [EnergyUnit]);
373
  TabSheetEnergyUtilization.Caption := TabSheetEnergyUtilization.Caption + ' (%)';
374
  TabSheetAATot.Caption := TabSheetAATot.Caption + Format(' (%s)', [AAUnit]);
375
  TabSheetAADig.Caption := TabSheetAADig.Caption + Format(' (%s)', [AAUnit]);
376
  TabSheetMinerals.Caption := TabSheetMinerals.Caption + Format(' (%s)', [MineralsUnit]);
377
  // Sauvegarder la WndProc actuelle du DBGrid
378
  DBGridNameOldWindowProc := DBGridName.WindowProc;
379
  DBGridMSOldWindowProc := DBGridMS.WindowProc;
380
  DBGridProximalOldWindowProc := DBGridProximal.WindowProc;
381
  DBGridRatiosOldWindowProc := DBGridRatios.WindowProc;
382
  DBGridEnergyOldWindowProc := DBGridEnergy.WindowProc;
383
  DBGridAATotOldWindowProc := DBGridAATot.WindowProc;
384
  DBGridAADigOldWindowProc := DBGridAADig.WindowProc;
385
  DBGridMineralsOldWindowProc := DBGridMinerals.WindowProc;
386
  // Affecter une nouvelle proc?dure de fen?tre
387
  DBGridName.WindowProc := DBGridNameNewWindowProc;
388
  DBGridMS.WindowProc := DBGridMSNewWindowProc;
389
  DBGridProximal.WindowProc := DBGridProximalNewWindowProc;
390
  DBGridRatios.WindowProc := DBGridRatiosNewWindowProc;
391
  DBGridEnergy.WindowProc := DBGridEnergyNewWindowProc;
392
  DBGridAATot.WindowProc := DBGridAATotNewWindowProc;
393
  DBGridAADig.WindowProc := DBGridAADigNewWindowProc;
394
  DBGridMinerals.WindowProc := DBGridMineralsNewWindowProc;
395
end;
396

    
397
procedure TFormFeedsList.FormResize(Sender: TObject);
398
begin
399
  // Adaptater la position et la taille de la liste des noms
400
  DBGridName.Top := TabSheetMS.Top;
401
  case PageControlLists.ActivePageIndex of
402
    0: DBGridName.Height := DBGridMS.Height;
403
    1: DBGridName.Height := DBGridProximal.Height;
404
    2: DBGridName.Height := DBGridRatios.Height;
405
    3: DBGridName.Height := DBGridEnergy.Height;
406
    4: DBGridName.Height := DBGridAATot.Height;
407
    5: DBGridName.Height := DBGridAADig.Height;
408
    6: DBGridName.Height := DBGridMinerals.Height;
409
  end;
410
end;
411

    
412
procedure TFormFeedsList.FormShow(Sender: TObject);
413
begin
414
  with DataModuleDeclaration do
415
//    ClientDataSetFeeds.Last;
416
    ClientDataSetFeeds.First;
417
  PageControlLists.ActivePageIndex := 0;
418
  PageControlListsChange(nil);
419
end;
420

    
421
procedure TFormFeedsList.PageControlListsChange(Sender: TObject);
422
begin
423
  FormResize(nil);
424
  // Activer la liste de l'onglet s?lectionn?
425
  case PageControlLists.ActivePageIndex of
426
    0: ActiveControl := DBGridMS;
427
    1: ActiveControl := DBGridProximal;
428
    2: ActiveControl := DBGridRatios;
429
    3: ActiveControl := DBGridEnergy;
430
    4: ActiveControl := DBGridAATot;
431
    5: ActiveControl := DBGridAADig;
432
    6: ActiveControl := DBGridMinerals;
433
  end;
434
end;
435

    
436
procedure TFormFeedsList.SplitterListMoved(Sender: TObject);
437
begin
438
  FormResize(nil);
439
end;
440

    
441
procedure TFormFeedsList.WMSysCommand(var Message: TWMSysCommand);
442
begin
443
  if Message.CmdType = SC_MINIMIZE
444
  then
445
    Application.Minimize
446
  else
447
    inherited;
448
end;
449

    
450
end.