Module

fOMNavA

Path

C:\CPRS\CPRS30\Orders\fOMNavA.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fBase508Form -
fFrame -
rOrders -
uConst -
uOrders -

Units Used in Implementation

Name Comments
fODAuto -
fODBase -
fODGen -
fOMVerify -
fOrders -
rMisc -
rODBase -
uCore -
uODBase -

Classes

Name Comments
TfrmOMNavA -
TMenuPath -

Procedures

Name Owner Declaration Scope Comments
accEventsGrdMenuCaptionQuery TfrmOMNavA procedure accEventsGrdMenuCaptionQuery(Sender: TObject; var Text: string); Public/Published -
accEventsGrdMenuValueQuery TfrmOMNavA procedure accEventsGrdMenuValueQuery(Sender: TObject; var Text: string); Public/Published -
ActivateDialog TfrmOMNavA procedure ActivateDialog(AnItem: TOrderMenuItem); Private -
AddToSelectList TfrmOMNavA procedure AddToSelectList(AnItem: TOrderMenuItem); Private Mouse & Keyboard Handling
ClearMenuGrid TfrmOMNavA procedure ClearMenuGrid; Private -
cmdDoneClick TfrmOMNavA procedure cmdDoneClick(Sender: TObject); Public/Published -
cmdNextClick TfrmOMNavA procedure cmdNextClick(Sender: TObject); Public/Published -
cmdPrevClick TfrmOMNavA procedure cmdPrevClick(Sender: TObject); Public/Published -
CMMouseLeave TfrmOMNavA procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; Private -
CreateParams TfrmOMNavA procedure CreateParams(var Params: TCreateParams); override; Public -
DoSelectList TfrmOMNavA procedure DoSelectList; Private -
FormActivate TfrmOMNavA procedure FormActivate(Sender: TObject); Public/Published -
FormClose TfrmOMNavA procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmOMNavA procedure FormCreate(Sender: TObject); Public/Published Form methods
FormDestroy TfrmOMNavA procedure FormDestroy(Sender: TObject); Public/Published -
FormResize TfrmOMNavA procedure FormResize(Sender: TObject); Public/Published -
grdMenuDrawCell TfrmOMNavA procedure grdMenuDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); Public/Published Draws each cell in the grid based on characteristics in associated OrderMenuItem object.
grdMenuKeyDown TfrmOMNavA procedure grdMenuKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
grdMenuKeyUp TfrmOMNavA procedure grdMenuKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
grdMenuMouseDown TfrmOMNavA procedure grdMenuMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
grdMenuMouseMove TfrmOMNavA procedure grdMenuMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Public/Published -
grdMenuMouseUp TfrmOMNavA procedure grdMenuMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
PlaceMenuItems TfrmOMNavA procedure PlaceMenuItems; Private Places the menu items in the proper grid cells
pnlToolMouseDown TfrmOMNavA procedure pnlToolMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published Imitate caption bar using panel at top of form
pnlToolMouseMove TfrmOMNavA procedure pnlToolMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Public/Published -
pnlToolMouseUp TfrmOMNavA procedure pnlToolMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
ResizeFont TfrmOMNavA procedure ResizeFont; Public -
SetEventDelay TfrmOMNavA procedure SetEventDelay(AnEvent: TOrderDelayEvent); Public -
SetNavButtons TfrmOMNavA procedure SetNavButtons; Private Menu navigation
SetNewMenu TfrmOMNavA procedure SetNewMenu(MenuIEN: Integer; AnOwner: TComponent; ARefNum: Integer); Public Creates a new 'starting' menu. For initial menu or menu from inside order set.
UMDestroy TfrmOMNavA procedure UMDestroy(var Message: TMessage); message UM_DESTROY; Private Sent by ordering dialog when it is closing

Functions

Name Owner Declaration Scope Comments
DialogNotDisabled TfrmOMNavA function DialogNotDisabled(DlgIEN: Integer): Boolean; Private -
FindOrderMenu TfrmOMNavA function FindOrderMenu(AMenu: Integer): TOrderMenu; Private Searchs the menu cache (FMenuHits) for a menu. If not there, load the menu from the server.

Global Variables

Name Type Declaration Comments
AlreadyRunning Boolean AlreadyRunning: Boolean = false; -
frmOMNavA TfrmOMNavA frmOMNavA: TfrmOMNavA; -

Constants

Name Declaration Scope Comments
TC_DISABLED 'Item Disabled' Global -
TC_NOFORM 'Missing Form ID' Global -
TC_ODACTIVE 'Unable to Select Item' Global -
TC_QO_NOSAVE 'Unable to Save Quick Order' Global -
TX_NOFORM 'This selection does not have an associated windows form.' Global -
TX_ODACTIVE 'An ordering dialog is already active.' Global -
TX_QO_NOSAVE 'Unexpected error - it was not possible to save this order.' Global -


Module Source

1     unit fOMNavA;
2     
3     {$ASSERTIONS OFF}
4     
5     interface
6     
7     uses
8       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9       Buttons, Grids, StdCtrls, ORCtrls, ExtCtrls, uConst, rOrders, uOrders, fFrame, fBase508Form,
10      VA508AccessibilityManager;
11    
12    type
13      TfrmOMNavA = class(TfrmBase508Form)
14        pnlTool: TPanel;
15        cmdDone: TORAlignButton;
16        grdMenu: TCaptionStringGrid;
17        cmdPrev: TBitBtn;
18        cmdNext: TBitBtn;
19        accEventsGrdMenu: TVA508ComponentAccessibility;
20        procedure FormActivate(Sender: TObject);
21        procedure FormClose(Sender: TObject; var Action: TCloseAction);
22        procedure FormCreate(Sender: TObject);
23        procedure grdMenuDrawCell(Sender: TObject; ACol, ARow: Integer;
24          Rect: TRect; State: TGridDrawState);
25        procedure grdMenuKeyDown(Sender: TObject; var Key: Word;
26          Shift: TShiftState);
27        procedure grdMenuMouseDown(Sender: TObject; Button: TMouseButton;
28          Shift: TShiftState; X, Y: Integer);
29        procedure grdMenuMouseMove(Sender: TObject; Shift: TShiftState; X,
30          Y: Integer);
31        procedure grdMenuMouseUp(Sender: TObject; Button: TMouseButton;
32          Shift: TShiftState; X, Y: Integer);
33        procedure pnlToolMouseDown(Sender: TObject; Button: TMouseButton;
34          Shift: TShiftState; X, Y: Integer);
35        procedure pnlToolMouseMove(Sender: TObject; Shift: TShiftState; X,
36          Y: Integer);
37        procedure pnlToolMouseUp(Sender: TObject; Button: TMouseButton;
38          Shift: TShiftState; X, Y: Integer);
39        procedure cmdDoneClick(Sender: TObject);
40        procedure cmdPrevClick(Sender: TObject);
41        procedure cmdNextClick(Sender: TObject);
42        procedure FormDestroy(Sender: TObject);
43        procedure grdMenuKeyUp(Sender: TObject; var Key: Word;
44          Shift: TShiftState);
45        procedure FormResize(Sender: TObject);
46        procedure accEventsGrdMenuCaptionQuery(Sender: TObject;
47          var Text: string);
48        procedure accEventsGrdMenuValueQuery(Sender: TObject;
49          var Text: string);
50      private
51        FOrderingMenu: Integer;
52        FLastCol: Integer;
53        FLastRow: Integer;
54        FMouseDown: Boolean;
55        FCtrlUp: Boolean;
56        FSelecting: Boolean;
57        FOrderMenuItem: TOrderMenuItem;
58        FMenuHits: TList; {of TOrderMenu}
59        FStack: TList; {of TMenuPath}
60        FQuickBitmap: TBitmap;
61        FOrigPoint: TPoint;
62        FStartPoint: TPoint;
63        FFormMove: Boolean;
64        FKeyVars: string;
65        FDelayEvent: TOrderDelayEvent;
66        FMenuStyle: Integer;
67        FRefNum: Integer;
68        FSelectList: TList; {of TOrderMenuItem}
69        FTheShift: TShiftState;
70        procedure ActivateDialog(AnItem: TOrderMenuItem);
71        procedure AddToSelectList(AnItem: TOrderMenuItem);
72        procedure ClearMenuGrid;
73        function DialogNotDisabled(DlgIEN: Integer): Boolean;
74        procedure DoSelectList;
75        function FindOrderMenu(AMenu: Integer): TOrderMenu;
76        procedure PlaceMenuItems;
77        procedure SetNavButtons;
78        procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
79        procedure UMDestroy(var Message: TMessage);    message UM_DESTROY;
80      public
81        procedure CreateParams(var Params: TCreateParams); override;
82        procedure SetEventDelay(AnEvent: TOrderDelayEvent);
83        procedure SetNewMenu(MenuIEN: Integer; AnOwner: TComponent; ARefNum: Integer);
84        procedure ResizeFont;
85        property RefNum: Integer read FRefNum write FRefNum;
86      end;
87    
88    var
89      frmOMNavA: TfrmOMNavA;
90      AlreadyRunning: Boolean = false;
91    
92    implementation
93    
94    {$R *.DFM}
95    
96    uses rODBase, ORFn, fODBase,fODGen, fODAuto, fOMVerify, uCore, rMisc, uODBase,
97      fOrders, VAUtils;
98    
99    const
100     TX_NOFORM    = 'This selection does not have an associated windows form.';
101     TC_NOFORM    = 'Missing Form ID';
102     TX_ODACTIVE  = 'An ordering dialog is already active.';
103     TC_ODACTIVE  = 'Unable to Select Item';
104     TX_QO_NOSAVE = 'Unexpected error - it was not possible to save this order.';
105     TC_QO_NOSAVE = 'Unable to Save Quick Order';
106     TC_DISABLED  = 'Item Disabled';
107   
108   type
109     TMenuPath = class
110       IENList: array of Integer;
111       OwnedBy: TComponent;
112       RefNum:  Integer;
113       Current: Integer;
114     end;
115   
116   procedure TfrmOMNavA.ClearMenuGrid;
117   var
118     ACol, ARow: Integer;
119   begin
120     with grdMenu do
121     begin
122       for ACol := 0 to ColCount - 1 do for ARow := 0 to RowCount - 1 do
123       begin
124         Objects[ACol, ARow] := nil;
125         Cells[ACol, ARow] := '';
126       end;
127       RowCount := 1;
128       ColCount := 1;
129       Cells[0, 0] := '';
130     end;
131   end;
132   
133   function TfrmOMNavA.FindOrderMenu(AMenu: Integer): TOrderMenu;
134   { searchs the menu cache (FMenuHits) for a menu.  If not there, load the menu from the server. }
135   var
136     i: Integer;
137     AnOrderMenu: TOrderMenu;
138   begin
139     i := 0;
140     Result := nil;
141     while (i < FMenuHits.Count) and (Result = nil) do          // search the menu cache
142     begin
143       AnOrderMenu := TOrderMenu(FMenuHits.Items[i]);
144       if AnOrderMenu.IEN = AMenu then Result := AnOrderMenu;
145       Inc(i);
146     end;
147     if Result = nil then                                       // load new menu from server
148     begin
149       AnOrderMenu := TOrderMenu.Create;
150       AnOrderMenu.IEN := AMenu;
151       AnOrderMenu.MenuItems := TList.Create;
152       LoadOrderMenu(AnOrderMenu, AMenu);
153       FMenuHits.Add(AnOrderMenu);
154       Result := AnOrderMenu;
155     end;
156   end;
157   
158   procedure TfrmOMNavA.PlaceMenuItems;
159   { places the menu items in the proper grid cells }
160   var
161     i: Integer;
162     OrderMenu: TOrderMenu;
163     OrderMenuItem: TOrderMenuItem;
164   begin
165     ClearMenuGrid;
166     OrderMenu := FindOrderMenu(FOrderingMenu);
167     if OrderMenu = nil then Exit;
168     pnlTool.Caption  := OrderMenu.Title;
169     grdMenu.ColCount := OrderMenu.NumCols;
170     FKeyVars         := OrderMenu.KeyVars;
171     grdMenu.DefaultColWidth := (grdMenu.ClientWidth div grdMenu.ColCount) - 1;
172     with OrderMenu.MenuItems do for i := 0 to Count - 1 do
173     begin
174       OrderMenuItem := TOrderMenuItem(Items[i]);
175       with grdMenu do
176       begin
177         if OrderMenuItem.Row >= RowCount then RowCount := OrderMenuItem.Row + 1;
178         if (OrderMenuItem.Col > -1) and (OrderMenuItem.Row > -1) then
179         begin
180           Cells[OrderMenuItem.Col, OrderMenuItem.Row] := OrderMenuItem.ItemText;
181           Objects[OrderMenuItem.Col, OrderMenuItem.Row] := OrderMenuItem;
182         end; {if OrderMenuItem}
183       end; {with grdMenu}
184     end; {for i}
185     with grdMenu do if VisibleRowCount < RowCount then
186       ColWidths[ColCount - 1] := DefaultColWidth - GetSystemMetrics(SM_CXVSCROLL);
187   end;
188   
189   procedure TfrmOMNavA.SetNewMenu(MenuIEN: Integer; AnOwner: TComponent; ARefNum: Integer);
190   { Creates a new 'starting' menu.  For initial menu or menu from inside order set. }
191   var
192     NewMenuPath: TMenuPath;
193   begin
194     NewMenuPath := TMenuPath.Create;
195     SetLength(NewMenuPath.IENList, 1);
196     NewMenuPath.IENList[0] := MenuIEN;
197     NewMenuPath.OwnedBy := AnOwner;
198     NewMenuPath.RefNum  := ARefNum;
199     NewMenuPath.Current := 0;
200     FStack.Add(NewMenuPath);
201     FOrderingMenu := MenuIEN;  // sets new starting point here
202     SetNavButtons;
203     PlaceMenuItems;            // displays menu, with nav & done buttons set
204     PushKeyVars(FKeyVars);
205     Self.Enabled := True;
206   end;
207   
208   { menu navigation }
209   
210   procedure TfrmOMNavA.SetNavButtons;
211   var
212     MenuPath: TMenuPath;
213   begin
214     with FStack do MenuPath := TMenuPath(Items[Count - 1]);
215     cmdPrev.Enabled := MenuPath.Current > 0;
216     cmdNext.Enabled := MenuPath.Current < High(MenuPath.IENList);
217     if FStack.Count > 1 then cmdDone.Caption := 'Next' else cmdDone.Caption := 'Done';
218     pnlTool.Invalidate;
219   end;
220   
221   procedure TfrmOMNavA.cmdPrevClick(Sender: TObject);
222   var
223     MenuPath: TMenuPath;
224   begin
225     with FStack do MenuPath := TMenuPath(Items[Count - 1]);
226     Dec(MenuPath.Current);
227     FOrderingMenu := MenuPath.IENList[MenuPath.Current];
228     SetNavButtons;
229     PlaceMenuItems;
230     PopKeyVars;
231   end;
232   
233   procedure TfrmOMNavA.cmdNextClick(Sender: TObject);
234   var
235     MenuPath: TMenuPath;
236   begin
237     with FStack do MenuPath := TMenuPath(Items[Count - 1]);
238     Inc(MenuPath.Current);
239     FOrderingMenu := MenuPath.IENList[MenuPath.Current];
240     SetNavButtons;
241     PlaceMenuItems;
242     PushKeyVars(FKeyVars);
243   end;
244   
245   procedure TfrmOMNavA.cmdDoneClick(Sender: TObject);
246   var
247     MenuPath: TMenuPath;
248   begin
249     if FSelecting then Exit;
250     with FStack do MenuPath := TMenuPath(Items[Count - 1]);
251     with FStack do Delete(Count - 1);
252     if FStack.Count = 0 then Close;
253     with MenuPath do if (OwnedBy <> nil) and (OwnedBy is TWinControl)
254       then SendMessage(TWinControl(OwnedBy).Handle, UM_DESTROY, RefNum, 0);
255     PopKeyVars(MenuPath.Current + 1);
256     MenuPath.Free;
257     if FStack.Count > 0 then
258     begin
259       with FStack do MenuPath := TMenuPath(Items[Count - 1]);
260       FOrderingMenu := MenuPath.IENList[MenuPath.Current];
261       SetNavButtons;
262       PlaceMenuItems;
263     end;
264   end;
265   
266   { Form methods }
267   
268   procedure TfrmOMNavA.FormCreate(Sender: TObject);
269   begin
270     FLastCol := -1;
271     FLastRow := -1;
272     FMenuStyle := OrderMenuStyle;
273     FMenuHits := TList.Create;
274     FStack := TList.Create;
275     FSelectList := TList.Create;
276     FQuickBitmap := TBitmap.Create;
277     FQuickBitmap.LoadFromResourceName(hInstance, 'BMP_QO_THIN');
278     NoFresh := True;
279     ResizeFont;
280   //  TAccessibleStringGrid.WrapControl(grdMenu);
281   end;
282   
283   procedure TfrmOMNavA.CreateParams(var Params: TCreateParams);
284   begin
285     inherited CreateParams(Params);
286     with Params do Style := (Style or WS_POPUP) and (not WS_DLGFRAME);
287     //with Params do Style := WS_THICKFRAME or WS_POPUP or WS_BORDER;
288   end;
289   
290   procedure TfrmOMNavA.UMDestroy(var Message: TMessage);
291   { sent by ordering dialog when it is closing }
292   begin
293     Self.Enabled := True;
294     Self.SetFocus;
295   end;
296   
297   procedure TfrmOMNavA.accEventsGrdMenuCaptionQuery(Sender: TObject;
298     var Text: string);
299   begin
300     Text := pnlTool.Caption;
301   end;
302   
303   procedure TfrmOMNavA.FormDestroy(Sender: TObject);
304   var
305     i, j: Integer;
306     OrderMenu: TOrderMenu;
307     OrderMenuItem: TOrderMenuItem;
308   begin
309   //  TAccessibleStringGrid.UnwrapControl(grdMenu);
310     ClearMenuGrid;
311     for i := 0 to FMenuHits.Count - 1 do
312     begin
313       OrderMenu := TOrderMenu(FMenuHits.Items[i]);
314       for j := 0 to OrderMenu.MenuItems.Count - 1 do
315       begin
316         OrderMenuItem := TOrderMenuItem(OrderMenu.MenuItems.Items[j]);
317         OrderMenuItem.Free;
318       end;
319       OrderMenu.MenuItems.Clear;
320       OrderMenu.MenuItems.Free;
321       OrderMenu.Free;
322     end;
323     FMenuHits.Free;
324     Assert(FStack.Count = 0);
325     FStack.Free;
326     Assert(FSelectList.Count = 0);
327     FSelectList.Free;
328     FQuickBitmap.Free;
329     DestroyingOrderMenu;
330     if (frmOrders.TheCurrentView<>nil) and (frmOrders.TheCurrentView.EventDelay.PtEventIFN>0)
331       and (IsCompletedPtEvt(frmOrders.TheCurrentView.EventDelay.PtEventIFN)) then
332       SendMessage(frmOrders.handle,UM_EVENTOCCUR,0,0);
333   end;
334   
335   procedure TfrmOMNavA.FormActivate(Sender: TObject);
336   begin
337     // do we need to bring something to front here?
338   end;
339   
340   procedure TfrmOMNavA.FormClose(Sender: TObject; var Action: TCloseAction);
341   var
342     MenuPath: TMenuPath;
343   begin
344     while FStack.Count > 0 do
345     begin
346       with FStack do MenuPath := TMenuPath(Items[Count - 1]);
347       with MenuPath do if (OwnedBy <> nil) and (OwnedBy is TWinControl)
348         then SendMessage(TWinControl(OwnedBy).Handle, UM_DESTROY, RefNum, 0);
349       PopKeyVars(MenuPath.Current + 1);
350       MenuPath.Free;
351       with FStack do Delete(Count - 1);
352     end;
353     SaveUserBounds(Self);
354     NoFresh := False;
355     Action := caFree;
356   end;
357   
358   procedure TfrmOMNavA.SetEventDelay(AnEvent: TOrderDelayEvent);
359   begin
360     FDelayEvent := AnEvent;
361   end;
362   
363   procedure TfrmOMNavA.grdMenuDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
364     State: TGridDrawState);
365   { Draws each cell in the grid based on characteristics in associated OrderMenuItem object. }
366   const
367     QO_BMP_WIDTH = 15;
368   var
369     OrderMenuItem: TOrderMenuItem;
370     AMnemonic: string;
371     MneRect, ItmRect: TRect;
372     MneWidth: integer;
373   begin
374     //if Sender = ActiveControl then Exit;
375     //if not (gdSelected in State) then Exit;
376     with Sender as TStringGrid do with Canvas do
377     begin
378       MneWidth := TextWidthByFont(Handle, 'MMM');
379       OrderMenuItem := TOrderMenuItem(grdMenu.Objects[ACol, ARow]);
380       if (OrderMenuItem <> nil) then with OrderMenuItem do
381       begin
382         Font.Style := [];
383         Font.Color := clWindowText;
384         if Selected    then
385         begin
386           Font.Color := Get508CompliantColor(clBlue);
387           Font.Style := Font.Style + [fsUnderline];
388         end;
389         if Display = 2 then
390           Font.Style := Font.Style + [fsBold];
391       end;
392       Brush.Color := Color;
393       if (FMenuStyle = 0) and
394         ((OrderMenuItem = nil) or ((OrderMenuItem <> nil) and (OrderMenuItem.Display <> 2))) then
395       begin
396         if OrderMenuItem <> nil then AMnemonic := OrderMenuItem.Mnemonic else AMnemonic := '';
397         FillRect(Rect);
398         MneRect.Left := Rect.Left + QO_BMP_WIDTH;
399         MneRect.Right := MneRect.Left + MneWidth;
400         MneRect.Top := Rect.Top + 2;
401         MneRect.Bottom := Rect.Bottom;
402         ItmRect.Left := Rect.Left + QO_BMP_WIDTH + MneWidth + 1;
403         ItmRect.Right := Rect.Right;
404         ItmRect.Top := Rect.Top + 2;
405         ItmRect.Bottom := Rect.Bottom;
406         TextRect(MneRect, MneRect.Left, MneRect.Top, AMnemonic);
407         TextRect(ItmRect, ItmRect.Left, ItmRect.Top, Cells[ACol, ARow]);
408       end
409       else TextRect(Rect, Rect.Left + QO_BMP_WIDTH, Rect.Top + 2, Cells[ACol, ARow]);
410       if (OrderMenuItem <> nil) and OrderMenuItem.AutoAck
411         then Draw(Rect.Left + 2, Rect.Top + 2, FQuickBitmap);	{ draw bitmap }
412       if gdSelected in State then
413       begin
414         Pen.Width := 1;
415         if FMouseDown then Pen.Color := clBtnShadow    else Pen.Color := clBtnHighlight;
416         MoveTo(Rect.Left,  Rect.Bottom - 1);
417         LineTo(Rect.Left,  Rect.Top);
418         LineTo(Rect.Right, Rect.Top);
419         if FMouseDown then Pen.Color := clBtnHighlight else Pen.Color := clBtnShadow;
420         LineTo(Rect.Right, Rect.Bottom);
421         LineTo(Rect.Left,  Rect.Bottom);
422       end;
423     end;
424   end;
425   
426   { Mouse & Keyboard Handling }
427   
428   procedure TfrmOMNavA.AddToSelectList(AnItem: TOrderMenuItem);
429   begin
430     if AnItem = nil then Exit;
431     FSelectList.Add(AnItem);
432     FSelecting := True;
433     cmdDone.Enabled := False;
434   end;
435   
436   procedure TfrmOMNavA.DoSelectList;
437   var
438     i: Integer;
439     x: string;
440     ItemList: TStringList;
441     AMenuItem: TOrderMenuItem;
442   begin
443     FSelecting := False;
444     cmdDone.Enabled := True;
445     if FSelectList.Count = 0 then Exit;
446     ItemList := TStringList.Create;
447     try
448       for i := 0 to FSelectList.Count - 1 do
449       begin
450         AMenuItem := TOrderMenuItem(FSelectList[i]);
451         if AMenuItem <> nil then
452         begin
453           x := IntToStr(AMenuItem.IEN) + U + AMenuItem.DlgType + U + AMenuItem.ItemText;
454           ItemList.Add(x);
455         end;
456       end;
457       if ItemList.Count > 0 then ActivateOrderList(ItemList, FDelayEvent, Self, 0, '', '');
458     finally
459       FSelectList.Clear;
460       ItemList.Free;
461     end;
462   end;
463   
464   procedure TfrmOMNavA.grdMenuKeyDown(Sender: TObject; var Key: Word;
465     Shift: TShiftState);
466   begin
467     //frmFrame.UpdatePtInfoOnRefresh;
468     if Key in [VK_RETURN, VK_SPACE] then with grdMenu do
469     begin
470       If AlreadyRunning then Exit
471       else AlreadyRunning := true;
472   
473       if frmOrders <> nil then
474       begin
475          if (frmOrders.TheCurrentView<>nil) and (frmOrders.TheCurrentView.EventDelay.PtEventIFN>0)
476            and IsCompletedPtEvt(frmOrders.TheCurrentView.EventDelay.PtEventIFN) then
477          begin
478            FDelayEvent.EventType := #0;
479            FDelayEvent.EventIFN  := 0;
480            FDelayEvent.TheParent := TParentEvent.Create;
481            FDelayEvent.EventName := '';
482            FDelayEvent.PtEventIFN := 0;
483          end;
484       end;
485       //frmFrame.UpdatePtInfoOnRefresh;
486       FOrderMenuItem := TOrderMenuItem(Objects[Col, Row]);
487       if Assigned(FOrderMenuItem) then
488         if FOrderMenuItem.Display > 0 then FOrderMenuItem := nil;          // display only
489       if FOrderMenuItem <> nil then
490       begin
491         FOrderMenuItem.Selected := True;
492         if ssCtrl in Shift
493           then AddToSelectList(FOrderMenuItem)
494           else ActivateDialog(FOrderMenuItem);
495         FOrderMenuItem := nil;
496         Key := 0;
497       end;
498       if frmOrders <> nil then
499       begin
500          if (frmOrders.TheCurrentView<>nil) and (frmOrders.TheCurrentView.EventDelay.PtEventIFN>0)
501            and IsCompletedPtEvt(frmOrders.TheCurrentView.EventDelay.PtEventIFN) then
502          begin
503            FDelayEvent.EventType := #0;
504            FDelayEvent.EventIFN  := 0;
505            FDelayEvent.TheParent := TParentEvent.Create;
506            FDelayEvent.EventName := '';
507            FDelayEvent.PtEventIFN := 0;
508          end;
509       end;
510     end;
511     if Key = VK_BACK then
512     begin
513       cmdPrevClick(Self);
514       Key := 0;
515     end;
516     if Key = VK_ESCAPE then
517     begin
518       cmdDoneClick(Self);
519       Key := 0;
520     end;
521     AlreadyRunning := false;
522   end;
523   
524   procedure TfrmOMNavA.grdMenuKeyUp(Sender: TObject; var Key: Word;
525     Shift: TShiftState);
526   begin
527     if Key = VK_CONTROL then
528     begin
529       if FMouseDown then FCtrlUp := True else DoSelectList;
530     end;
531   end;
532   
533   procedure TfrmOMNavA.grdMenuMouseDown(Sender: TObject;
534     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
535   var
536     ACol, ARow: Integer;
537   begin
538     //frmFrame.UpdatePtInfoOnRefresh;
539     if ssDouble in Shift then
540     begin
541       FTheShift := [ssDouble];
542       Exit;  // ignore a double click
543     end;
544     if frmOrders <> nil then
545     begin
546       if (frmOrders.TheCurrentView<>nil) and (frmOrders.TheCurrentView.EventDelay.PtEventIFN>0)
547         and IsCompletedPtEvt(frmOrders.TheCurrentView.EventDelay.PtEventIFN) then
548       begin
549         FDelayEvent.EventType := #0;
550         FDelayEvent.EventIFN  := 0;
551         FDelayEvent.TheParent := TParentEvent.Create;
552         FDelayEvent.EventName := '';
553         FDelayEvent.PtEventIFN := 0;
554       end;
555     end;
556     //frmFrame.UpdatePtInfoOnRefresh;
557     with grdMenu do
558     begin
559       MouseToCell(X, Y, ACol, ARow);
560       if (ACol > -1) and (ARow > -1) and (ACol < grdMenu.ColCount) and (ARow < grdMenu.RowCount) then
561       begin
562         FMouseDown := True;
563         FOrderMenuItem := TOrderMenuItem(Objects[ACol, ARow]);
564         // check to see if this is a display only field
565         if (FOrderMenuItem <> nil) and (FOrderMenuItem.Display > 0) then FOrderMenuItem := nil;
566         if  FOrderMenuItem <> nil then FOrderMenuItem.Selected := True;
567       end;
568     end;
569   end;
570   
571   procedure TfrmOMNavA.grdMenuMouseMove(Sender: TObject; Shift: TShiftState;
572     X, Y: Integer);
573   var
574     ACol, ARow: Integer;
575   begin
576     grdMenu.MouseToCell(X, Y, ACol, ARow);
577     if (ACol = FLastCol) and (ARow = FLastRow) then Exit;
578     if (ACol > -1) and (ARow > -1) and (ACol < grdMenu.ColCount) and (ARow < grdMenu.RowCount) then
579     begin
580       FLastCol := ACol;
581       FLastRow := ARow;
582       grdMenu.Col := ACol;
583       grdMenu.Row := ARow;
584     end;
585   end;
586   
587   procedure TfrmOMNavA.grdMenuMouseUp(Sender: TObject; Button: TMouseButton;
588     Shift: TShiftState; X, Y: Integer);
589   begin
590     if ssDouble in Shift then Exit;  // ignore a double click
591     if ssDouble in FTheShift then
592     begin
593       FTheShift := [];
594       Exit;
595     end;
596   
597     If AlreadyRunning then Exit
598     else AlreadyRunning := true;
599   
600     FMouseDown := False;
601     //grdMenu.Invalidate;
602     // may want to check here to see if mouse still over the same item
603     if ssCtrl in Shift then AddToSelectList(FOrderMenuItem) else
604     begin
605       if FCtrlUp then
606       begin
607         FCtrlUp := False;
608         AddToSelectList(FOrderMenuItem);
609         DoSelectList;
610       end
611       else ActivateDialog(FOrderMenuItem);
612     end;
613     FCtrlUp := False;
614     FOrderMenuItem := nil;
615     if frmOrders <> nil then
616     begin
617       if (frmOrders.TheCurrentView<>nil) and (frmOrders.TheCurrentView.EventDelay.PtEventIFN>0)
618         and IsCompletedPtEvt(frmOrders.TheCurrentView.EventDelay.PtEventIFN) then
619       begin
620         FDelayEvent.EventType := #0;
621         FDelayEvent.EventIFN  := 0;
622         FDelayEvent.TheParent := TParentEvent.Create;
623         FDelayEvent.EventName := '';
624         FDelayEvent.PtEventIFN := 0;
625       end;
626     end;
627     AlreadyRunning := False;
628   end;
629   
630   procedure TfrmOMNavA.CMMouseLeave(var Message: TMessage);
631   begin
632     inherited;
633     FLastCol := -1;
634     FLastRow := -1;
635   end;
636   
637   function TfrmOMNavA.DialogNotDisabled(DlgIEN: Integer): Boolean;
638   var
639     x: string;
640   begin
641     Result := True;
642     x := OrderDisabledMessage(DlgIEN);
643     if Length(x) > 0 then
644     begin
645       Result := False;
646       InfoBox(x, TC_DISABLED, MB_OK);
647     end;
648   end;
649   
650   procedure TfrmOMNavA.accEventsGrdMenuValueQuery(Sender: TObject;
651     var Text: string);
652   var
653     OrderMenuItem : TOrderMenuItem;
654   begin
655     inherited;
656     if grdMenu.Objects[grdMenu.Col, grdMenu.Row] is TOrderMenuItem then begin
657       OrderMenuItem := TOrderMenuItem(grdMenu.Objects[grdMenu.Col, grdMenu.Row]);
658       Text := OrderMenuItem.Mnemonic + ', ' + OrderMenuItem.ItemText;
659       if OrderMenuItem.AutoAck then
660         Text := 'Auto Accept, '+ Text;
661     end;
662   end;
663   
664   procedure TfrmOMNavA.ActivateDialog(AnItem: TOrderMenuItem);
665   var
666     MenuPath: TMenuPath;
667   begin
668     if AnItem = nil then Exit;
669     case AnItem.DlgType of
670     #0:  { ignore if no type, i.e., display header or blank };
671     'A': ActivateAction(IntToStr(AnItem.IEN) + ';' + IntToStr(AnItem.FormID), Self, 0);
672     'D': ActivateOrderDialog(IntToStr(AnItem.IEN), FDelayEvent, Self, 0);
673     'M': begin
674            // this simply moves to new menu, rather than open a new form as in ActivateOrderMenu
675            if DialogNotDisabled(AnItem.IEN) then
676            begin
677              with FStack do MenuPath := TMenuPath(Items[Count - 1]);
678              with MenuPath do
679              begin
680                Inc(Current);
681                if Current > High(IENList) then SetLength(IENList, Current + 1);
682                if Current <> AnItem.IEN then
683                begin
684                  IENList := Copy(IENList, 0, Current + 1);
685                  IENList[Current] := AnItem.IEN;
686                end;
687                FOrderingMenu := AnItem.IEN;
688                SetNavButtons;
689                PlaceMenuItems;
690                PushKeyVars(FKeyVars);
691                with grdMenu do
692                  GoodNotifyWinEvent(EVENT_OBJECT_FOCUS, Handle, integer(OBJID_CLIENT), ColRowToIndex(Col,Row));
693              end; {with MenuPath}
694            end; {if}
695          end; {'M'}
696     'Q': ActivateOrderDialog(IntToStr(AnItem.IEN), FDelayEvent, Self, 0);
697     'P': ShowMsg('Order Dialogs of type "Prompt" cannot be processed.');
698     'O': begin
699            // disable initially, since the 1st item in the set may be a menu
700            Self.Enabled := False;
701            if not ActivateOrderSet(IntToStr(AnItem.IEN), FDelayEvent, Self, 0)
702              then Self.Enabled := True;
703          end;
704     else ShowMsg('Unknown Order Dialog type: ' + AnItem.DlgType);
705     end; {case}
706   end;
707   
708   { imitate caption bar using panel at top of form }
709   
710   procedure TfrmOMNavA.pnlToolMouseDown(Sender: TObject;
711     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
712   begin
713     if Button <> mbLeft then Exit;
714     FStartPoint := TControl(Sender).ClientToScreen(Point(X, Y));
715     FOrigPoint  := Point(Left, Top);
716     FFormMove   := True;
717   end;
718   
719   procedure TfrmOMNavA.pnlToolMouseMove(Sender: TObject; Shift: TShiftState;
720     X, Y: Integer);
721   var
722     NewPoint: TPoint;
723   begin
724     if FFormMove then
725     begin
726       NewPoint := TControl(Sender).ClientToScreen(Point(X, Y));
727       SetBounds(FOrigPoint.X - (FStartPoint.X - NewPoint.X),
728                 FOrigPoint.Y - (FStartPoint.Y - NewPoint.Y), Width, Height);
729     end;
730   end;
731   
732   procedure TfrmOMNavA.pnlToolMouseUp(Sender: TObject; Button: TMouseButton;
733     Shift: TShiftState; X, Y: Integer);
734   begin
735     FFormMove := False;
736   end;
737   
738   procedure TfrmOMNavA.FormResize(Sender: TObject);
739   begin
740     grdMenu.DefaultColWidth := (grdMenu.ClientWidth div grdMenu.ColCount) - 1;
741     grdMenu.Refresh;
742   end;
743   
744   procedure TfrmOMNavA.ResizeFont;
745   begin
746     ResizeAnchoredFormToFont(Self);
747     grdMenu.Canvas.Font := grdMenu.Font;
748   end;
749   
750   end.

Module Calls (2 levels)


fOMNavA
 ├uConst
 ├rOrders
 │ ├uCore
 │ ├rCore
 │ ├uConst
 │ ├UBAGlobals
 │ └UBACore
 ├uOrders
 │ ├uConst
 │ ├rConsults
 │ ├rOrders...
 │ ├fODBase
 │ ├XuDsigS
 │ ├fODDiet
 │ ├fODMisc
 │ ├fODGen
 │ ├fODMedIn
 │ ├fODMedOut
 │ ├fODText
 │ ├fODConsult
 │ ├fODProc
 │ ├fODRad
 │ ├fODLab
 │ ├fODBBank
 │ ├fODMeds
 │ ├fODMedIV
 │ ├fODVitals
 │ ├fODAuto
 │ ├fOMNavA...
 │ ├rCore...
 │ ├uCore...
 │ ├fFrame
 │ ├fEncnt
 │ ├fOMVerify
 │ ├fOrderSaveQuick
 │ ├fOMSet
 │ ├rMisc
 │ ├uODBase
 │ ├rODMeds
 │ ├fLkUpLocation
 │ ├fOrdersPrint
 │ ├fOMAction
 │ ├fARTAllgy
 │ ├fOMHTML
 │ ├fOrders
 │ ├rODBase
 │ ├fODChild
 │ ├fMeds
 │ ├rMeds
 │ ├rPCE
 │ ├fRptBox
 │ ├fODMedNVA
 │ ├fODChangeUnreleasedRenew
 │ ├rODAllergy
 │ ├UBAGlobals...
 │ └uTemplateFields
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rODBase...
 ├fODBase...
 ├rMisc...
 ├uODBase...
 └fOrders...

Module Called-By (2 levels)


                     fOMNavA
                   uOrders┘ 
                   uCore┤   
                 fODBase┤   
                 rODBase┤   
                  fFrame┤   
                 fOrders┤   
             fOrdersSign┤   
                   fMeds┤   
               fARTAllgy┤   
                  fNotes┤   
               fConsults┤   
         fReminderDialog┤   
                 fReview┤   
            fOrdersRenew┤   
               fOrdersCV┤   
                 fODMeds┤   
              fOMNavA...┤   
         fOrderSaveQuick┤   
                  fOMSet┤   
          fOrdersRelease┤   
                 fOMHTML┤   
               fODMedNVA┤   
fODChangeUnreleasedRenew┤   
          fOrdersOnChart┤   
         fODReleaseEvent┤   
               fODActive┘