| 1 | unit fOMVerify; | 
|---|
| 2 |  | 
|---|
| 3 | interface | 
|---|
| 4 |  | 
|---|
| 5 | uses | 
|---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
| 7 | fAutoSz, StdCtrls, ComCtrls; | 
|---|
| 8 |  | 
|---|
| 9 | type | 
|---|
| 10 | TfrmOMVerify = class(TfrmAutoSz) | 
|---|
| 11 | cmdAccept: TButton; | 
|---|
| 12 | cmdEdit: TButton; | 
|---|
| 13 | cmdCancel: TButton; | 
|---|
| 14 | memText: TRichEdit; | 
|---|
| 15 | procedure cmdAcceptClick(Sender: TObject); | 
|---|
| 16 | procedure cmdEditClick(Sender: TObject); | 
|---|
| 17 | procedure cmdCancelClick(Sender: TObject); | 
|---|
| 18 | procedure FormCreate(Sender: TObject); | 
|---|
| 19 | procedure FormClose(Sender: TObject; var Action: TCloseAction); | 
|---|
| 20 | procedure memTextKeyUp(Sender: TObject; var Key: Word; | 
|---|
| 21 | Shift: TShiftState); | 
|---|
| 22 | private | 
|---|
| 23 | FLevel: Integer; | 
|---|
| 24 | end; | 
|---|
| 25 |  | 
|---|
| 26 | procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean = False); | 
|---|
| 27 |  | 
|---|
| 28 | implementation | 
|---|
| 29 |  | 
|---|
| 30 | {$R *.DFM} | 
|---|
| 31 |  | 
|---|
| 32 | uses ORFn, uConst, fFrame, rMisc, uODBase; | 
|---|
| 33 |  | 
|---|
| 34 | procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean); | 
|---|
| 35 | var | 
|---|
| 36 | frmOMVerify: TfrmOMVerify; | 
|---|
| 37 | tempStrs,prompts: TStringList; | 
|---|
| 38 | flag: boolean; | 
|---|
| 39 | HasObjects: boolean; | 
|---|
| 40 |  | 
|---|
| 41 | function CutoffOutptPrompts(const promptIDs: TStringList; var promptList: TStringList): boolean; | 
|---|
| 42 | var | 
|---|
| 43 | i,j: integer; | 
|---|
| 44 | begin | 
|---|
| 45 | result := False; | 
|---|
| 46 | for i := 0 to promptList.Count - 1 do | 
|---|
| 47 | begin | 
|---|
| 48 | if result = True then | 
|---|
| 49 | break; | 
|---|
| 50 | for j := 0 to promptIDs.Count - 1 do | 
|---|
| 51 | begin | 
|---|
| 52 | if Pos(promptIDs[j],LowerCase(promptList[i]))>0 then | 
|---|
| 53 | begin | 
|---|
| 54 | promptList.Delete(i); | 
|---|
| 55 | result := True; | 
|---|
| 56 | break; | 
|---|
| 57 | end; | 
|---|
| 58 | end; | 
|---|
| 59 | end; | 
|---|
| 60 | end; | 
|---|
| 61 |  | 
|---|
| 62 | begin | 
|---|
| 63 | prompts := TStringList.Create; | 
|---|
| 64 | prompts.Add('supply'); | 
|---|
| 65 | prompts.Add('quantity'); | 
|---|
| 66 | prompts.Add('refill'); | 
|---|
| 67 | prompts.Add('pick up'); | 
|---|
| 68 | prompts.Add('priority'); | 
|---|
| 69 | frmOMVerify := TfrmOMVerify.Create(Application); | 
|---|
| 70 | try | 
|---|
| 71 | ResizeFormToFont(TForm(frmOMVerify)); | 
|---|
| 72 | if InptDispGrp then | 
|---|
| 73 | begin | 
|---|
| 74 | tempStrs := TStringList.Create; | 
|---|
| 75 | TStrings(tempStrs).SetText(PChar(VerifyText)); | 
|---|
| 76 | repeat | 
|---|
| 77 | flag := CutoffOutptPrompts(prompts, tempStrs); | 
|---|
| 78 | until not flag; | 
|---|
| 79 | SetString(VerifyText, tempStrs.GetText, StrLen(tempStrs.GetText)) | 
|---|
| 80 | end; | 
|---|
| 81 |  | 
|---|
| 82 | with frmOMVerify do | 
|---|
| 83 | begin | 
|---|
| 84 | SetBounds(frmFrame.Left, frmFrame.Top + frmFrame.Height - Height, Width, Height); | 
|---|
| 85 | SetFormPosition(frmOMVerify); | 
|---|
| 86 | ExpandOrderObjects(VerifyText, HasObjects); | 
|---|
| 87 | memText.Lines.SetText(PChar(VerifyText)); | 
|---|
| 88 | ShowModal; | 
|---|
| 89 | QuickLevel := FLevel; | 
|---|
| 90 | end; | 
|---|
| 91 | finally | 
|---|
| 92 | frmOMVerify.Release; | 
|---|
| 93 | end; | 
|---|
| 94 | end; | 
|---|
| 95 |  | 
|---|
| 96 |  | 
|---|
| 97 | procedure TfrmOMVerify.FormCreate(Sender: TObject); | 
|---|
| 98 | begin | 
|---|
| 99 | inherited; | 
|---|
| 100 | FLevel := QL_CANCEL; | 
|---|
| 101 | end; | 
|---|
| 102 |  | 
|---|
| 103 | procedure TfrmOMVerify.cmdAcceptClick(Sender: TObject); | 
|---|
| 104 | begin | 
|---|
| 105 | inherited; | 
|---|
| 106 | FLevel := QL_AUTO; | 
|---|
| 107 | Close; | 
|---|
| 108 | end; | 
|---|
| 109 |  | 
|---|
| 110 | procedure TfrmOMVerify.cmdEditClick(Sender: TObject); | 
|---|
| 111 | begin | 
|---|
| 112 | inherited; | 
|---|
| 113 | FLevel := QL_DIALOG; | 
|---|
| 114 | Close; | 
|---|
| 115 | end; | 
|---|
| 116 |  | 
|---|
| 117 | procedure TfrmOMVerify.cmdCancelClick(Sender: TObject); | 
|---|
| 118 | begin | 
|---|
| 119 | inherited; | 
|---|
| 120 | FLevel := QL_CANCEL; | 
|---|
| 121 | Close; | 
|---|
| 122 | end; | 
|---|
| 123 |  | 
|---|
| 124 | procedure TfrmOMVerify.FormClose(Sender: TObject; | 
|---|
| 125 | var Action: TCloseAction); | 
|---|
| 126 | begin | 
|---|
| 127 | inherited; | 
|---|
| 128 | SaveUserBounds(Self); | 
|---|
| 129 | end; | 
|---|
| 130 |  | 
|---|
| 131 | procedure TfrmOMVerify.memTextKeyUp(Sender: TObject; var Key: Word; | 
|---|
| 132 | Shift: TShiftState); | 
|---|
| 133 | begin | 
|---|
| 134 | inherited; | 
|---|
| 135 | if (Key = VK_TAB) then | 
|---|
| 136 | begin | 
|---|
| 137 | if ssShift in Shift then | 
|---|
| 138 | begin | 
|---|
| 139 | FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control | 
|---|
| 140 | Key := 0; | 
|---|
| 141 | end | 
|---|
| 142 | else if ssCtrl      in Shift then | 
|---|
| 143 | begin | 
|---|
| 144 | FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control | 
|---|
| 145 | Key := 0; | 
|---|
| 146 | end; | 
|---|
| 147 | end; | 
|---|
| 148 | if (key = VK_ESCAPE) then begin | 
|---|
| 149 | FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control | 
|---|
| 150 | key := 0; | 
|---|
| 151 | end; | 
|---|
| 152 | end; | 
|---|
| 153 |  | 
|---|
| 154 | end. | 
|---|