source: cprs/trunk/CPRS-Chart/Orders/fOMNavA.pas@ 1708

Last change on this file since 1708 was 1679, checked in by healthsevak, 10 years ago

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