source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOMVerify.pas@ 697

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

Uploading from OR_30_258

File size: 3.7 KB
RevLine 
[459]1unit fOMVerify;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ComCtrls;
8
9type
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
26procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean = False);
27
28implementation
29
30{$R *.DFM}
31
[460]32uses ORFn, uConst, fFrame, rMisc, uODBase;
[459]33
34procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean);
35var
36 frmOMVerify: TfrmOMVerify;
37 tempStrs,prompts: TStringList;
38 flag: boolean;
[460]39 HasObjects: boolean;
[459]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
62begin
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);
[460]86 ExpandOrderObjects(VerifyText, HasObjects);
[459]87 memText.Lines.SetText(PChar(VerifyText));
88 ShowModal;
89 QuickLevel := FLevel;
90 end;
91 finally
92 frmOMVerify.Release;
93 end;
94end;
95
96
97procedure TfrmOMVerify.FormCreate(Sender: TObject);
98begin
99 inherited;
100 FLevel := QL_CANCEL;
101end;
102
103procedure TfrmOMVerify.cmdAcceptClick(Sender: TObject);
104begin
105 inherited;
106 FLevel := QL_AUTO;
107 Close;
108end;
109
110procedure TfrmOMVerify.cmdEditClick(Sender: TObject);
111begin
112 inherited;
113 FLevel := QL_DIALOG;
114 Close;
115end;
116
117procedure TfrmOMVerify.cmdCancelClick(Sender: TObject);
118begin
119 inherited;
120 FLevel := QL_CANCEL;
121 Close;
122end;
123
124procedure TfrmOMVerify.FormClose(Sender: TObject;
125 var Action: TCloseAction);
126begin
127 inherited;
128 SaveUserBounds(Self);
129end;
130
131procedure TfrmOMVerify.memTextKeyUp(Sender: TObject; var Key: Word;
132 Shift: TShiftState);
133begin
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;
152end;
153
154end.
Note: See TracBrowser for help on using the repository browser.