source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fOMNavA.pas@ 525

Last change on this file since 525 was 453, checked in by Kevin Toppenberg, 17 years ago

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