144 lines
3.5 KiB
Plaintext
144 lines
3.5 KiB
Plaintext
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.
|