source: cprs/branches/tmg-cprs/CPRS-Chart/fPtSelMsg.pas@ 873

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 3.8 KB
Line 
1//kt -- Modified with SourceScanner on 8/15/2007
2unit fPtSelMsg;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 ExtCtrls, StdCtrls, ComCtrls, DKLang;
9
10type
11 TfrmPtSelMsg = class(TForm)
12 cmdClose: TButton;
13 timClose: TTimer;
14 memMessages: TRichEdit;
15 DKLanguageController1: TDKLanguageController;
16 procedure FormClose(Sender: TObject; var Action: TCloseAction);
17 procedure cmdCloseClick(Sender: TObject);
18 procedure timCloseTimer(Sender: TObject);
19 procedure FormCreate(Sender: TObject);
20 procedure FormDestroy(Sender: TObject);
21 private
22 FSeconds: Integer;
23 FChanging: boolean;
24 FEventsActive: boolean;
25 FOldActiveFormChanged: TNotifyEvent;
26 FOldTabChanged: TNotifyEvent;
27 procedure ClearEvents;
28 procedure TabChanged(Sender: TObject);
29 procedure ActiveFormChanged(Sender: TObject);
30 public
31 { Public declarations }
32 end;
33
34procedure ShowPatientSelectMessages(const AMsg: string);
35procedure HidePatientSelectMessages;
36
37implementation
38
39{$R *.DFM}
40
41uses ORFn, uCore, fFrame;
42
43var
44 frmPtSelMsg: TfrmPtSelMsg = nil;
45
46procedure ShowPatientSelectMessages(const AMsg: string);
47begin
48 if assigned(frmPtSelMsg) then
49 begin
50 frmPtSelMsg.Free;
51 frmPtSelMsg := nil;
52 end;
53 if Length(AMsg) = 0 then Exit;
54 frmPtSelMsg := TfrmPtSelMsg.Create(Application);
55 ResizeAnchoredFormToFont(frmPtSelMsg);
56 frmPtSelMsg.memMessages.Lines.SetText(PChar(AMsg)); // Text := AMsg doesn't seem to work
57 frmPtSelMsg.memMessages.SelStart := 0;
58 if User.PtMsgHang = 0
59 then frmPtSelMsg.timClose.Enabled := False
60 else
61 begin
62 //frmPtSelMsg.timClose.Interval := User.PtMsgHang * 1000;
63 frmPtSelMsg.FSeconds := User.PtMsgHang;
64 frmPtSelMsg.timClose.Enabled := True;
65 end;
66 frmPtSelMsg.Show;
67end;
68
69procedure HidePatientSelectMessages;
70begin
71 if assigned(frmPtSelMsg) then
72 begin
73 frmPtSelMsg.Free;
74 frmPtSelMsg := nil;
75 end;
76end;
77
78procedure TfrmPtSelMsg.timCloseTimer(Sender: TObject);
79begin
80 Dec(FSeconds);
81 if FSeconds > 0
82// then Caption := 'Patient Lookup Messages (Auto-Close in ' + IntToStr(FSeconds) + ' seconds)' <-- original line. //kt 8/15/2007
83 then Caption := DKLangConstW('fPtSelMsg_Patient_Lookup_Messages___xAutoxClose_in') + ' ' + IntToStr(FSeconds) + DKLangConstW('fPtSelMsg_secondsx') //kt added 8/15/2007
84 else Close;
85end;
86
87procedure TfrmPtSelMsg.cmdCloseClick(Sender: TObject);
88begin
89 Close;
90end;
91
92procedure TfrmPtSelMsg.FormClose(Sender: TObject; var Action: TCloseAction);
93begin
94 Action := caFree;
95end;
96
97procedure TfrmPtSelMsg.FormCreate(Sender: TObject);
98begin
99 memMessages.Color := ReadOnlyColor;
100 FOldActiveFormChanged := Screen.OnActiveFormChange;
101 Screen.OnActiveFormChange := ActiveFormChanged;
102 FOldTabChanged := frmFrame.OnTabChanged;
103 frmFrame.OnTabChanged := TabChanged;
104 FEventsActive := TRUE;
105end;
106
107procedure TfrmPtSelMsg.FormDestroy(Sender: TObject);
108begin
109 ClearEvents;
110 frmPtSelMsg := nil;
111end;
112
113procedure TfrmPtSelMsg.ActiveFormChanged(Sender: TObject);
114begin
115 if assigned(FOldActiveFormChanged) then
116 FOldActiveFormChanged(Sender);
117 if (not FChanging) and (Screen.ActiveForm <> Self) and
118 (not (csDestroying in Self.ComponentState)) then
119 begin
120 FChanging := TRUE;
121 try
122 SetFocus;
123 finally
124 FChanging := FALSE;
125 end;
126 end;
127end;
128
129procedure TfrmPtSelMsg.ClearEvents;
130begin
131 if FEventsActive then
132 begin
133 Screen.OnActiveFormChange := FOldActiveFormChanged;
134 frmFrame.OnTabChanged := FOldTabChanged;
135 FEventsActive := FALSE;
136 end;
137end;
138
139procedure TfrmPtSelMsg.TabChanged(Sender: TObject);
140begin
141 if assigned(FOldTabChanged) then
142 FOldTabChanged(Sender);
143 ClearEvents;
144end;
145
146end.
Note: See TracBrowser for help on using the repository browser.