| 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.
|
|---|
