unit fPtSelMsg; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ComCtrls; type TfrmPtSelMsg = class(TForm) cmdClose: TButton; timClose: TTimer; memMessages: TRichEdit; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure cmdCloseClick(Sender: TObject); procedure timCloseTimer(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FSeconds: Integer; FChanging: boolean; FEventsActive: boolean; FOldActiveFormChanged: TNotifyEvent; FOldTabChanged: TNotifyEvent; procedure ClearEvents; procedure TabChanged(Sender: TObject); procedure ActiveFormChanged(Sender: TObject); public { Public declarations } end; procedure ShowPatientSelectMessages(const AMsg: string); procedure HidePatientSelectMessages; implementation {$R *.DFM} uses ORFn, uCore, fFrame; var frmPtSelMsg: TfrmPtSelMsg = nil; procedure ShowPatientSelectMessages(const AMsg: string); begin if assigned(frmPtSelMsg) then begin frmPtSelMsg.Free; frmPtSelMsg := nil; end; if Length(AMsg) = 0 then Exit; frmPtSelMsg := TfrmPtSelMsg.Create(Application); ResizeAnchoredFormToFont(frmPtSelMsg); frmPtSelMsg.memMessages.Lines.SetText(PChar(AMsg)); // Text := AMsg doesn't seem to work frmPtSelMsg.memMessages.SelStart := 0; if User.PtMsgHang = 0 then frmPtSelMsg.timClose.Enabled := False else begin //frmPtSelMsg.timClose.Interval := User.PtMsgHang * 1000; frmPtSelMsg.FSeconds := User.PtMsgHang; frmPtSelMsg.timClose.Enabled := True; end; frmPtSelMsg.Show; end; procedure HidePatientSelectMessages; begin if assigned(frmPtSelMsg) then begin frmPtSelMsg.Free; frmPtSelMsg := nil; end; end; procedure TfrmPtSelMsg.timCloseTimer(Sender: TObject); begin Dec(FSeconds); if FSeconds > 0 then Caption := 'Patient Lookup Messages (Auto-Close in ' + IntToStr(FSeconds) + ' seconds)' else Close; end; procedure TfrmPtSelMsg.cmdCloseClick(Sender: TObject); begin Close; end; procedure TfrmPtSelMsg.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; procedure TfrmPtSelMsg.FormCreate(Sender: TObject); begin memMessages.Color := ReadOnlyColor; FOldActiveFormChanged := Screen.OnActiveFormChange; Screen.OnActiveFormChange := ActiveFormChanged; FOldTabChanged := frmFrame.OnTabChanged; frmFrame.OnTabChanged := TabChanged; FEventsActive := TRUE; end; procedure TfrmPtSelMsg.FormDestroy(Sender: TObject); begin ClearEvents; frmPtSelMsg := nil; end; procedure TfrmPtSelMsg.ActiveFormChanged(Sender: TObject); begin if assigned(FOldActiveFormChanged) then FOldActiveFormChanged(Sender); if (not FChanging) and (Screen.ActiveForm <> Self) and (not (csDestroying in Self.ComponentState)) then begin FChanging := TRUE; try SetFocus; finally FChanging := FALSE; end; end; end; procedure TfrmPtSelMsg.ClearEvents; begin if FEventsActive then begin Screen.OnActiveFormChange := FOldActiveFormChanged; frmFrame.OnTabChanged := FOldTabChanged; FEventsActive := FALSE; end; end; procedure TfrmPtSelMsg.TabChanged(Sender: TObject); begin if assigned(FOldTabChanged) then FOldTabChanged(Sender); ClearEvents; end; end.