source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOMNavA.pas@ 1714

Last change on this file since 1714 was 459, checked in by Kevin Toppenberg, 16 years ago

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