source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fOMVerify.pas@ 1722

Last change on this file since 1722 was 1693, checked in by healthsevak, 9 years ago

Committing the files for first time to this new branch

File size: 5.4 KB
Line 
1unit fOMVerify;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ComCtrls, VA508AccessibilityManager, VA508AccessibilityRouter;
8
9type
10 TfrmOMVerify = class(TfrmAutoSz)
11 cmdAccept: TButton;
12 cmdEdit: TButton;
13 cmdCancel: TButton;
14 memText: TRichEdit;
15 VA508ComponentAccessibility1: TVA508ComponentAccessibility;
16 procedure cmdAcceptClick(Sender: TObject);
17 procedure cmdEditClick(Sender: TObject);
18 procedure cmdCancelClick(Sender: TObject);
19 procedure FormCreate(Sender: TObject);
20 procedure FormClose(Sender: TObject; var Action: TCloseAction);
21 procedure memTextKeyUp(Sender: TObject; var Key: Word;
22 Shift: TShiftState);
23 procedure FormDestroy(Sender: TObject);
24 procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
25 var Text: string);
26 procedure FormShow(Sender: TObject);
27 procedure memTextKeyDown(Sender: TObject; var Key: Word;
28 Shift: TShiftState);
29 private
30 FLevel: Integer;
31 end;
32
33procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean = False);
34
35var
36 frmOMVerify: TfrmOMVerify;
37implementation
38
39{$R *.DFM}
40
41uses ORFn, uConst, fFrame, rMisc, uODBase;
42
43procedure ShowVerifyText(var QuickLevel: Integer; var VerifyText: string; InptDispGrp: boolean);
44var
45 //frmOMVerify: TfrmOMVerify;
46 tempStrs,prompts: TStringList;
47 flag: boolean;
48 HasObjects: boolean;
49
50 function CutoffOutptPrompts(const promptIDs: TStringList; var promptList: TStringList): boolean;
51 var
52 i,j: integer;
53 begin
54 result := False;
55 for i := 0 to promptList.Count - 1 do
56 begin
57 if result = True then
58 break;
59 for j := 0 to promptIDs.Count - 1 do
60 begin
61 if Pos(promptIDs[j],LowerCase(promptList[i]))>0 then
62 begin
63 promptList.Delete(i);
64 result := True;
65 break;
66 end;
67 end;
68 end;
69 end;
70
71begin
72 prompts := TStringList.Create;
73 prompts.Add('supply');
74 prompts.Add('quantity');
75 prompts.Add('refill');
76 prompts.Add('pick up');
77 prompts.Add('priority');
78 frmOMVerify := TfrmOMVerify.Create(Application);
79 ResizeFormToFont(TForm(frmOMVerify));
80 if InptDispGrp then
81 begin
82 tempStrs := TStringList.Create;
83 TStrings(tempStrs).SetText(PChar(VerifyText));
84 repeat
85 flag := CutoffOutptPrompts(prompts, tempStrs);
86 until not flag;
87 SetString(VerifyText, tempStrs.GetText, StrLen(tempStrs.GetText))
88 end;
89 SetFormPosition(frmOMVerify);
90 ExpandOrderObjects(VerifyText, HasObjects);
91 frmOMVerify.memText.Lines.SetText(PChar(VerifyText));
92 frmOMVerify.ShowModal;
93 if frmOMVerify.ModalResult = mrOK then
94 begin
95 QuickLevel := frmOMVerify.FLevel;
96 end;
97 //agp on CPRS timeout ModalResult equal mrCancel this prevent starting a new order
98 //when the chart is timing out.
99 if frmOMVerify.ModalResult = mrCancel then QuickLevel := QL_CANCEL;
100 frmOMVerify.Free;
101end;
102
103
104procedure TfrmOMVerify.FormCreate(Sender: TObject);
105begin
106 inherited;
107 frmOMVerify := nil;
108 FLevel := QL_CANCEL;
109 ModalResult := mrNone;
110end;
111
112
113procedure TfrmOMVerify.FormDestroy(Sender: TObject);
114begin
115 inherited;
116 frmOMVerify := nil;
117end;
118
119procedure TfrmOMVerify.FormShow(Sender: TObject);
120begin
121 inherited;
122 if ScreenReaderSystemActive then
123 begin
124 memText.TabStop := true;
125 memText.SetFocus;
126 end;
127end;
128
129procedure TfrmOMVerify.cmdAcceptClick(Sender: TObject);
130begin
131 inherited;
132 FLevel := QL_AUTO;
133 ModalResult := mrOK;
134end;
135
136procedure TfrmOMVerify.cmdEditClick(Sender: TObject);
137begin
138 inherited;
139 FLevel := QL_DIALOG;
140 ModalResult := mrOK;
141end;
142
143procedure TfrmOMVerify.cmdCancelClick(Sender: TObject);
144begin
145 inherited;
146 FLevel := QL_CANCEL;
147 ModalResult := mrOK;
148end;
149
150procedure TfrmOMVerify.FormClose(Sender: TObject;
151 var Action: TCloseAction);
152begin
153 inherited;
154 SaveUserBounds(Self);
155end;
156
157procedure TfrmOMVerify.memTextKeyDown(Sender: TObject; var Key: Word;
158 Shift: TShiftState);
159begin
160 inherited;
161 if ShiftTabIsPressed() then
162 begin
163 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
164 Key := 0;
165 end;
166 if TabIsPressed() then
167 begin
168 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
169 Key := 0;
170 end;
171 if (key = VK_ESCAPE) then begin
172 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
173 key := 0;
174 end;
175end;
176
177procedure TfrmOMVerify.memTextKeyUp(Sender: TObject; var Key: Word;
178 Shift: TShiftState);
179begin
180 inherited;
181 {if (Key = VK_TAB) then
182 begin
183 if ssShift in Shift then
184 begin
185 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
186 Key := 0;
187 end
188 else if ssCtrl in Shift then
189 begin
190 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
191 Key := 0;
192 end;
193 end;
194 if (key = VK_ESCAPE) then begin
195 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
196 key := 0;
197 end; }
198end;
199
200procedure TfrmOMVerify.VA508ComponentAccessibility1StateQuery(Sender: TObject;
201 var Text: string);
202begin
203 inherited;
204 Text := memText.Text;
205end;
206
207end.
Note: See TracBrowser for help on using the repository browser.