source: cprs/trunk/CPRS-Chart/Consults/fEditProc.pas@ 1672

Last change on this file since 1672 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27
File size: 20.6 KB
RevLine 
[456]1unit fEditProc;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
[829]8 Menus, fBase508Form, VA508AccessibilityManager;
[456]9
10type
[829]11 TfrmEditProc = class(TfrmBase508Form)
[456]12 cmdAccept: TButton;
13 cmdQuit: TButton;
14 cboUrgency: TORComboBox;
15 radInpatient: TRadioButton;
16 radOutpatient: TRadioButton;
17 cboPlace: TORComboBox;
18 txtProvDiag: TCaptionEdit;
19 txtAttn: TORComboBox;
20 lblProc: TLabel;
21 cboProc: TORComboBox;
22 lblReason: TLabel;
23 lblUrgency: TStaticText;
24 lblPlace: TStaticText;
25 lblAttn: TStaticText;
26 lblProvDiag: TStaticText;
27 cboCategory: TORComboBox;
28 cboService: TORComboBox;
29 lblService: TOROffsetLabel;
30 memComment: TRichEdit;
31 lblComment: TLabel;
32 lblComments: TLabel;
33 pnlMessage: TPanel;
34 imgMessage: TImage;
35 memMessage: TRichEdit;
36 btnCmtCancel: TButton;
37 btnCmtOther: TButton;
38 mnuPopProvDx: TPopupMenu;
39 mnuPopProvDxDelete: TMenuItem;
40 cmdLexSearch: TButton;
41 lblInpOutp: TStaticText;
42 memReason: TRichEdit;
43 popReason: TPopupMenu;
44 popReasonCut: TMenuItem;
45 popReasonCopy: TMenuItem;
46 popReasonPaste: TMenuItem;
47 popReasonPaste2: TMenuItem;
48 popReasonReformat: TMenuItem;
49 procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
50 Direction, InsertAt: Integer);
51 procedure cboProcNeedData(Sender: TObject; const StartFrom: String;
52 Direction, InsertAt: Integer);
53 procedure radInpatientClick(Sender: TObject);
54 procedure radOutpatientClick(Sender: TObject);
55 procedure ControlChange(Sender: TObject);
56 procedure FormClose(Sender: TObject; var Action: TCloseAction);
57 procedure cboProcSelect(Sender: TObject);
58 procedure memReasonExit(Sender: TObject);
59 procedure cmdAcceptClick(Sender: TObject);
60 procedure cmdQuitClick(Sender: TObject);
61 procedure OrderMessage(const AMessage: string);
62 procedure btnCmtCancelClick(Sender: TObject);
63 procedure btnCmtOtherClick(Sender: TObject);
64 procedure cmdLexSearchClick(Sender: TObject);
65 procedure mnuPopProvDxDeleteClick(Sender: TObject);
66 procedure popReasonCutClick(Sender: TObject);
67 procedure popReasonCopyClick(Sender: TObject);
68 procedure popReasonPasteClick(Sender: TObject);
69 procedure popReasonPopup(Sender: TObject);
70 procedure popReasonReformatClick(Sender: TObject);
71 procedure memCommentKeyUp(Sender: TObject; var Key: Word;
72 Shift: TShiftState);
73 procedure memReasonKeyDown(Sender: TObject; var Key: Word;
74 Shift: TShiftState);
75 procedure memReasonKeyPress(Sender: TObject; var Key: Char);
76 private
77 FLastProcID: string;
78 FChanged: boolean;
79 FChanging: boolean;
80 FEditCtrl: TCustomEdit;
81 FNavigatingTab: boolean;
82 procedure SetProvDiagPromptingMode;
83 protected
84 procedure InitDialog;
85 procedure Validate(var AnErrMsg: string);
86 function ValidSave: Boolean;
87 end;
88
89
90function EditResubmitProcedure(FontSize: Integer; ConsultIEN: integer): boolean;
91
92var
93 frmEditProc: TfrmEditProc;
94
95implementation
96
97{$R *.DFM}
98
99uses
100 rConsults, uCore, rCore, fConsults, rODBase, fRptBox, fPCELex, rPCE, ORClasses, clipbrd ;
101
102var
103 OldRec, NewRec: TEditResubmitRec;
104 Defaults: TStringList;
105 uMessageVisible: DWORD;
106 ProvDx: TProvisionalDiagnosis;
107
108const
109 TX_NO_PROC = 'A procedure must be specified.' ;
110 TX_NO_REASON = 'A reason for this procedure must be entered.' ;
111 TX_NO_SERVICE = 'A service must be selected to perform this procedure.';
112 TX_NO_URGENCY = 'An urgency must be specified.';
113 TX_NO_PLACE = 'A place of consultation must be specified';
114 TX_NO_DIAG = 'A provisional diagnosis must be entered for consults to this service.';
115 TX_SELECT_DIAG = 'You must use the "Lexicon" button to select a diagnosis for consults to this service.';
116 TX_INACTIVE_CODE = 'The provisional diagnosis code is not active as of today''s date.' + #13#10 +
117 'Another code must be selected';
118 TC_INACTIVE_CODE = 'Inactive ICD Code';
119
120function EditResubmitProcedure(FontSize: Integer; ConsultIEN: integer): boolean;
121begin
122 Result := False;
123 if ConsultIEN = 0 then exit;
124 FillChar(OldRec, SizeOf(OldRec), 0);
125 FillChar(NewRec, SizeOf(NewRec), 0);
126 FillChar(ProvDx, SizeOf(ProvDx), 0);
127 OldRec := LoadConsultForEdit(ConsultIEN);
128 NewRec.IEN := OldRec.IEN;
129 NewRec.RequestType := OldRec.RequestType;
130 with NewRec do
131 begin
132 RequestReason:= TStringList.Create ;
133 DenyComments:= TStringList.Create ;
134 OtherComments:= TStringList.Create ;
135 NewComments:= TStringList.Create ;
136 end;
137 StatusText('Loading Procedure for Edit');
138 frmEditProc := TfrmEditProc.Create(Application);
139 Defaults := TStringList.Create;
140 try
141 ResizeAnchoredFormToFont(frmEditProc);
142 with frmEditProc do
143 begin
144 FChanged := False;
145 InitDialog;
146 ShowModal ;
147 Result := FChanged ;
148 end ;
149 finally
150 OldRec.RequestReason.Free;
151 OldRec.DenyComments.Free;
152 OldRec.OtherComments.Free;
153 OldRec.NewComments.Free;
154 NewRec.RequestReason.Free;
155 NewRec.DenyComments.Free;
156 NewRec.OtherComments.Free;
157 NewRec.NewComments.Free;
158 Defaults.Free;
159 frmEditProc.Release;
160 end;
161end;
162
163procedure TfrmEditProc.InitDialog;
164var
165 i: integer;
166begin
167 FChanging := True;
168 Defaults := TStringList.Create;
[829]169 FastAssign(ODForProcedures, Defaults);
[456]170 FLastProcID := '';
171 cboProc.InitLongList(OldRec.ConsultProcName) ;
172 cboProc.SelectByIEN(OldRec.OrderableItem);
173 if cboProc.ItemIndex = -1 then
174 begin
175 cboProc.Items.Insert(0, IntToStr(OldRec.OrderableItem) + U + OldRec.ConsultProcName +
176 U + OldRec.ConsultProcName + U + OldRec.ConsultProc);
177 cboProc.ItemIndex := 0;
178 end;
179 cboProcSelect(Self);
180 txtAttn.InitLongList(OldRec.AttnName) ;
181 if OldRec.Attention > 0 then
182 txtAttn.SelectByIEN(OldRec.Attention)
183 else
184 txtAttn.ItemIndex := -1;
185 cboService.SelectByIEN(OldRec.ToService);
186 if OldRec.InpOutp <> '' then
187 case OldRec.InpOutp[1] of
188 'I': radInpatient.Checked := True; //INPATIENT PROCEDURE
189 'O': radOutpatient.Checked := True; //OUTPATIENT PROCEDURE
190 end
191 else
192 begin
193 if Patient.Inpatient then
194 radInpatient.Checked := True
195 else
196 radOutpatient.Checked := True;
197 end;
198 cboPlace.SelectByID(OldRec.Place);
199 with cboUrgency do for i := 0 to Items.Count-1 do
200 if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i;
201 txtProvDiag.Text := OldRec.ProvDiagnosis;
202 ProvDx.Code := OldRec.ProvDxCode;
203 if OldRec.ProvDxCodeInactive then
204 begin
205 InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
206 ProvDx.CodeInactive := True;
207 end;
[829]208 QuickCopy(OldRec.RequestReason, memReason);
[456]209 btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0);
210 btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0);
211 memComment.Clear ;
212 SetProvDiagPromptingMode;
213 FChanging := False;
214 StatusText('');
215end;
216
217procedure TfrmEditProc.Validate(var AnErrMsg: string);
218
219 procedure SetError(const x: string);
220 begin
221 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
222 AnErrMsg := AnErrMsg + x;
223 end;
224
225begin
226 if cboProc.ItemIEN = 0 then SetError(TX_NO_PROC);
227 if memReason.Lines.Count = 0 then SetError(TX_NO_REASON);
228 if cboService.ItemIEN = 0 then SetError(TX_NO_SERVICE);
229 if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
230 if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
231 if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
232 begin
233 if ProvDx.PromptMode = 'F' then
234 SetError(TX_NO_DIAG)
235 else
236 SetError(TX_SELECT_DIAG);
237 end;
238 if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
239 SetError(TX_INACTIVE_CODE);
240end;
241
242procedure TfrmEditProc.txtAttnNeedData(Sender: TObject;
243 const StartFrom: string; Direction, InsertAt: Integer);
244begin
245 inherited;
246 txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
247end;
248
249procedure TfrmEditProc.cboProcNeedData(Sender: TObject;
250 const StartFrom: string; Direction, InsertAt: Integer);
251begin
252 inherited;
253 cboProc.ForDataUse(SubSetOfProcedures(StartFrom, Direction));
254end;
255
256procedure TfrmEditProc.radInpatientClick(Sender: TObject);
257begin
258 inherited;
259 cboCategory.Items.Clear;
260 cboCategory.Items.Add('I^Inpatient');
261 cboCategory.SelectById('I');
262 ExtractItems(cboPlace.Items, Defaults, 'Inpt Place');
263 ExtractItems(cboUrgency.Items, Defaults, 'Inpt Proc Urgencies'); //S.GMRCR
264 ControlChange(Self);
265end;
266
267procedure TfrmEditProc.radOutpatientClick(Sender: TObject);
268begin
269 inherited;
270 cboCategory.Items.Clear;
271 cboCategory.Items.Add('O^Outpatient');
272 cboCategory.SelectById('O');
273 ExtractItems(cboPlace.Items, Defaults, 'Outpt Place');
274 ExtractItems(cboUrgency.Items, Defaults, 'Outpt Urgencies'); //S.GMRCO
275 ControlChange(Self);
276end;
277
278procedure TfrmEditProc.ControlChange(Sender: TObject);
279begin
280 if FChanging then exit;
281 with NewRec do
282 begin
283 with cboProc do if ItemIEN > 0 then
284 if Piece(Items[ItemIndex], U, 4) <> OldRec.ConsultProc then
285 begin
286 ConsultProc := Piece(Items[ItemIndex], U, 4);
287 ConsultProcName := Text;
288 end
289 else
290 begin
291 ConsultProc := '';
292 ConsultProcName := '';
293 end;
294
295 with cboService do if ItemIEN > 0 then
296 if ItemIEN <> OldRec.ToService then
297 begin
298 ToService := ItemIEN;
299 ToServiceName := Text;
300 end
301 else
302 begin
303 ToService := 0;
304 ToServiceName := '';
305 end;
306
307 with cboCategory do if Length(ItemID) > 0 then
308 if ItemID <> OldRec.InpOutP then
309 InpOutP := ItemID
310 else
311 InpOutP := '';
312
313 with cboUrgency do if ItemIEN > 0 then
314 if StrToIntDef(Piece(Items[ItemIndex], U, 3), 0) <> OldRec.Urgency then
315 begin
316 Urgency := StrToIntDef(Piece(Items[ItemIndex], U, 3), 0);
317 UrgencyName := Text;
318 end
319 else
320 begin
321 Urgency := 0;
322 UrgencyName := '';
323 end;
324
325
326 with cboPlace do if Length(ItemID) > 0 then
327 if ItemID <> OldRec.Place then
328 begin
329 Place := ItemID;
330 PlaceName := Text;
331 end
332 else
333 begin
334 Place := '';
335 PlaceName := '';
336 end;
337
338 with txtAttn do
339 if ItemIEN > 0 then
340 begin
341 if ItemIEN <> OldRec.Attention then
342 begin
343 Attention := ItemIEN;
344 AttnName := Text;
345 end
346 else
347 begin
348 Attention := 0;
349 AttnName := '';
350 end;
351 end
352 else // blank
353 begin
354 if OldRec.Attention > 0 then
355 begin
356 Attention := -1;
357 AttnName := '';
358 end
359 else
360 begin
361 Attention := 0;
362 AttnName := '';
363 end;
364 end;
365
366 with txtProvDiag do
367 if Length(Text) > 0 then
368 begin
369 if Text <> OldRec.ProvDiagnosis then
370 ProvDiagnosis := Text
371 else
372 ProvDiagnosis := '';
373
374 if ProvDx.Code <> OldRec.ProvDxCode then
375 ProvDxCode := ProvDx.Code
376 else
377 ProvDxCode := '';
378
379 if OldRec.ProvDxCodeInactive then
380 ProvDx.CodeInactive := (ProvDx.Code = OldRec.ProvDxCode);
381 end
382 else //blank
383 begin
384 ProvDx.Code := '';
385 ProvDx.CodeInactive := False;
386 if OldRec.ProvDiagnosis <> '' then
387 ProvDiagnosis := '@'
388 else
389 ProvDiagnosis := '';
390 end;
391
392 with memReason do if Lines.Count > 0 then
393 if Lines.Equals(OldRec.RequestReason) then
394 RequestReason.Clear
395 else
[829]396 QuickCopy(memReason, RequestReason);
[456]397
398 with memComment do
399 if GetTextLen > 0 then
[829]400 QuickCopy(memComment, NewComments)
[456]401 else
402 NewComments.Clear;
403 end;
404end;
405
406procedure TfrmEditProc.FormClose(Sender: TObject; var Action: TCloseAction);
407const
408 TX_ACCEPT = 'Resubmit this request?' + CRLF + CRLF;
409 TX_ACCEPT_CAP = 'Unsaved Changes';
410begin
411 if FChanged then
412 if InfoBox(TX_ACCEPT, TX_ACCEPT_CAP, MB_YESNO) = ID_YES then
413 if not ValidSave then Action := caNone;
414end;
415
416function TfrmEditProc.ValidSave: Boolean;
417const
418 TX_NO_SAVE = 'This request cannot be saved for the following reason(s):' + CRLF + CRLF;
419 TX_NO_SAVE_CAP = 'Unable to Save Request';
420 TX_SAVE_ERR = 'Unexpected error - it was not possible to save this request.';
421var
422 ErrMsg: string;
423begin
424 Result := True;
425 Validate(ErrMsg);
426 if Length(ErrMsg) > 0 then
427 begin
428 InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
429 Result := False;
430 end;
431 if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) and (ProvDx.PromptMode = 'L') then
432 cmdLexSearchClick(Self);
433end;
434
435procedure TfrmEditProc.cboProcSelect(Sender: TObject);
436begin
437 inherited;
438 with cboProc do
439 begin
440 if ItemIndex = -1 then Exit;
441 if ItemID <> FLastProcID then FLastProcID := ItemID else Exit;
442 with cboService do
443 begin
444 Clear;
[829]445 FastAssign(GetProcedureServices(cboProc.ItemIEN), cboService.Items);
[456]446 if Items.Count > 0 then
447 begin
448 ItemIndex := 0 ;
449 NewRec.ToService := ItemIEN;
450 NewRec.ToServiceName := Text;
451 end
452 else
453 begin
454 InfoBox('There are no services defined for this procedure.',
455 'Information', MB_OK or MB_ICONINFORMATION);
456 cboProc.ItemIndex := -1;
457 InitDialog;
458 Exit ;
459 end;
460 end;
461 end;
462 OrderMessage(ConsultMessage(cboProc.ItemIEN));
463 ControlChange(Self) ;
464end;
465
466procedure TfrmEditProc.memReasonExit(Sender: TObject);
467var
468 AStringList: TStringList;
469begin
470 inherited;
471 AStringList := TStringList.Create;
472 try
[829]473 //QuickCopy(memReason, AStringList);
474 AStringList.Text := memReason.Text;
[456]475 LimitStringLength(AStringList, 74);
[829]476 //QuickCopy(AstringList, memReason);
477 memReason.Text := AStringList.Text;
[456]478 ControlChange(Self);
479 finally
480 AStringList.Free;
481 end;
482end;
483
484procedure TfrmEditProc.cmdAcceptClick(Sender: TObject);
485begin
486 if ValidSave then
487 begin
488 FChanged := (ResubmitConsult(NewRec) = '0');
489 Close;
490 end;
491end;
492
493procedure TfrmEditProc.cmdQuitClick(Sender: TObject);
494begin
495 inherited;
496 FChanged := False;
497 Close;
498end;
499
500procedure TfrmEditProc.OrderMessage(const AMessage: string);
501begin
502 memMessage.Lines.SetText(PChar(AMessage));
503 if ContainsVisibleChar(AMessage) then
504 begin
505 pnlMessage.Visible := True;
506 pnlMessage.BringToFront;
507 uMessageVisible := GetTickCount;
508 end
509 else pnlMessage.Visible := False;
510end;
511
512procedure TfrmEditProc.btnCmtCancelClick(Sender: TObject);
513begin
514 ReportBox(OldRec.DenyComments, 'Cancellation Comments', False);
515end;
516
517procedure TfrmEditProc.btnCmtOtherClick(Sender: TObject);
518begin
519 ReportBox(OldRec.OtherComments, 'Added Comments', False);
520end;
521
522
523
524procedure TfrmEditProc.cmdLexSearchClick(Sender: TObject);
525var
526 Match: string;
527 i: integer;
528begin
529 inherited;
530 LexiconLookup(Match, LX_ICD);
531 if Match = '' then Exit;
532 ProvDx.Code := Piece(Match, U, 1);
533 ProvDx.Text := Piece(Match, U, 2);
534 i := Pos(' (ICD', ProvDx.Text);
535 if i = 0 then i := Length(ProvDx.Text) + 1;
536 if ProvDx.Text[i-1] = '*' then i := i - 2;
537 ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
538 txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
539 ProvDx.CodeInactive := False;
540end;
541
542procedure TfrmEditProc.SetProvDiagPromptingMode;
543const
544 TX_USE_LEXICON = 'You must use the "Lexicon" button to select a provisional diagnosis for this service.';
545 TX_PROVDX_OPT = 'Provisional Diagnosis';
546 TX_PROVDX_REQD = 'Provisional Dx (REQUIRED)';
547begin
548 cmdLexSearch.Enabled := False;
549 txtProvDiag.Enabled := False;
550 txtProvDiag.ReadOnly := True;
551 txtProvDiag.Color := clBtnFace;
552 txtProvDiag.Font.Color := clBtnText;
553 lblProvDiag.Enabled := False;
554 txtProvDiag.Hint := '';
555 if cboProc.ItemIEN = 0 then Exit;
556 //GetProvDxMode(ProvDx, cboService.ItemID);
557 GetProvDxMode(ProvDx, Piece(cboProc.Items[cboProc.ItemIndex], U, 4));
558 // Returns: string A^B
559 // A = O (optional), R (required) or S (suppress)
560 // B = F (free-text) or L (lexicon)
561 with ProvDx do if (Reqd = '') or (PromptMode = '') then Exit;
562 if ProvDx.Reqd = 'R' then
563 lblProvDiag.Caption := TX_PROVDX_REQD
564 else
565 lblProvDiag.Caption := TX_PROVDX_OPT;
566 if ProvDx.Reqd = 'S' then
567 begin
568 cmdLexSearch.Enabled := False;
569 txtProvDiag.Enabled := False;
570 txtProvDiag.ReadOnly := True;
571 txtProvDiag.Color := clBtnFace;
572 txtProvDiag.Font.Color := clBtnText;
573 lblProvDiag.Enabled := False;
574 end
575 else
576 case ProvDx.PromptMode[1] of
577 'F': begin
578 cmdLexSearch.Enabled := False;
579 txtProvDiag.Enabled := True;
580 txtProvDiag.ReadOnly := False;
581 txtProvDiag.Color := clWindow;
582 txtProvDiag.Font.Color := clWindowText;
583 lblProvDiag.Enabled := True;
584 end;
585 'L': begin
586 cmdLexSearch.Enabled := True;
587 txtProvDiag.Enabled := True;
588 txtProvDiag.ReadOnly := True;
589 txtProvDiag.Color := clInfoBk;
590 txtProvDiag.Font.Color := clInfoText;
591 lblProvDiag.Enabled := True;
592 txtProvDiag.Hint := TX_USE_LEXICON;
593 end;
594 end;
595end;
596
597procedure TfrmEditProc.mnuPopProvDxDeleteClick(Sender: TObject);
598begin
599 inherited;
600 ProvDx.Text := '';
601 ProvDx.Code := '';
602 ProvDx.CodeInactive := False;
603 txtProvDiag.Text := '';
604 ControlChange(Self);
605end;
606
607procedure TfrmEditProc.popReasonPopup(Sender: TObject);
608begin
609 inherited;
610 if PopupComponent(Sender, popReason) is TCustomEdit
611 then FEditCtrl := TCustomEdit(PopupComponent(Sender, popReason))
612 else FEditCtrl := nil;
613 if FEditCtrl <> nil then
614 begin
615 popReasonCut.Enabled := FEditCtrl.SelLength > 0;
616 popReasonCopy.Enabled := popReasonCut.Enabled;
617 popReasonPaste.Enabled := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
618 Clipboard.HasFormat(CF_TEXT);
619 end else
620 begin
621 popReasonCut.Enabled := False;
622 popReasonCopy.Enabled := False;
623 popReasonPaste.Enabled := False;
624 end;
625 popReasonReformat.Enabled := True;
626end;
627
628procedure TfrmEditProc.popReasonCutClick(Sender: TObject);
629begin
630 inherited;
631 FEditCtrl.CutToClipboard;
632end;
633
634procedure TfrmEditProc.popReasonCopyClick(Sender: TObject);
635begin
636 inherited;
637 FEditCtrl.CopyToClipboard;
638end;
639
640procedure TfrmEditProc.popReasonPasteClick(Sender: TObject);
641begin
642 inherited;
643 FEditCtrl.SelText := Clipboard.AsText;
644end;
645
646procedure TfrmEditProc.popReasonReformatClick(Sender: TObject);
647begin
648 if (Screen.ActiveControl <> memReason) and
649 (Screen.ActiveControl <> memComment)then Exit;
650 ReformatMemoParagraph(TCustomMemo(FEditCtrl));
651end;
652
653
654procedure TfrmEditProc.memCommentKeyUp(Sender: TObject; var Key: Word;
655 Shift: TShiftState);
656begin
657 if FNavigatingTab then
658 begin
659 if ssShift in Shift then
660 FindNextControl(Sender as TWinControl, False, True, False).SetFocus //previous control
661 else if ssCtrl in Shift then
662 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
663 end;
664 if (key = VK_ESCAPE) then begin
665 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
666 key := 0;
667 end;
668end;
669
670procedure TfrmEditProc.memReasonKeyDown(Sender: TObject; var Key: Word;
671 Shift: TShiftState);
672begin
673 //The navigating tab controls were inadvertantently adding tab characters
674 //This should fix it
675 FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
676 if FNavigatingTab then
677 Key := 0;
678end;
679
680procedure TfrmEditProc.memReasonKeyPress(Sender: TObject; var Key: Char);
681begin
682 if FNavigatingTab then
683 Key := #0; //Disable shift-tab processing
684end;
685
686end.
687
688
Note: See TracBrowser for help on using the repository browser.