VistA-cprs/BDK32/Source/SgnonCnf.pas

603 lines
19 KiB
Plaintext

{ **************************************************************
Package: XWB - Kernel RPCBroker
Date Created: Sept 18, 1997 (Version 1.1)
Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
Developers: Danila Manapsal, Don Craven, Joel Ivey
Description: Signon Form Configuration Dialog.
Current Release: Version 1.1 Patch 40 (January 7, 2005))
*************************************************************** }
{**************************************************
1.1P31 - Modified to store signon configuration under
the HKCU key - this permits users on NT2000
machines who have USER access to set their
configuration. Also, makes configuration specific
to users on machines which might be shared.
Also make it so that configuration is only written
to the registry when the user indicates that it
should be saved (previously the default values
were written into the registry as well as applied
to the window if data was not in the registry).
The default values previously stored in the registry
would override any changes in the signon window
design via coding. To overcome this, if the user
does not have saved configuration data, the window
generated on opening will be used as the default, and
the default data written into the registry as defaults.
This will permit the user to restore to the current
window defaults if desired, but will not overwrite
changes released for the window in later patches.
************************************************************}
unit Sgnoncnf;
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, ExtCtrls, Dialogs, SysUtils, MFunStr, XWBut1;
type
TSignonValues = class(TObject)
private
FHeight: Integer;
FWidth: Integer;
FTextColor: LongInt;
FPosition: String;
FSize: String;
FIntroFont: String;
FIntroFontStyles: String;
FBackColor: LongInt;
FFont: TFont;
FFontStyles: TFontStyles;
FTop: Integer;
FLeft: Integer;
procedure SetSize(const Value: String);
procedure SetPosition(const Value: String);
procedure SetIntroFont(const Value: String);
procedure SetIntroFontStyles(const Value: String);
procedure SetFont(Value: TFont);
procedure SetTextColor(Value: LongInt);
public
procedure Clear; virtual;
constructor Create;
destructor Destroy; override;
procedure SetEqual(EqualToValue: TSignonValues);
property Height: Integer read FHeight write FHeight;
property Width: Integer read FWidth write FWidth;
property TextColor: LongInt read FTextColor write SetTextColor;
property Position: String read FPosition write SetPosition;
property Size: String read FSize write SetSize;
property IntroFont: String read FIntroFont write SetIntroFont;
property IntroFontStyles: String read FIntroFontStyles write SetIntroFontStyles;
property BackColor: LongInt read FBackColor write FBackColor;
property Font: TFont read FFont write SetFont;
property FontStyles: TFontStyles read FFontStyles write FFontStyles;
property Top: Integer read FTop write FTop;
property Left: Integer read FLeft write FLeft;
end;
TSignonConfiguration = class;
{
This class is the form shown for configuration of the signon form
}
TfrmSignonConfig = class(TForm)
OKBtn: TBitBtn;
CancelBtn: TBitBtn;
HelpBtn: TBitBtn;
Bevel1: TBevel;
rgrWindowPosition: TRadioGroup;
rgrWindowSize: TRadioGroup;
FontDialog1: TFontDialog;
GroupBox1: TGroupBox;
Button1: TButton;
btnDefaults: TBitBtn;
rgrIntroBackClr: TRadioGroup;
ColorDialog1: TColorDialog;
procedure Button1Click(Sender: TObject);
procedure OKBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure rgrIntroBackClrClick(Sender: TObject);
private
{ Private declarations }
FController: TSignonConfiguration;
public
property Controller: TSignonConfiguration read FController write FController;
{ Public declarations }
end;
{
This class handles the processing for signon configuration
}
TSignonConfiguration = class(TObject)
private
OrigHelp: String;
FIntroBackColor: LongInt;
FIntroFontValue: String;
FIntroFontStyles: String;
FIntroTextColor: LongInt;
FPosition: String;
FSize: String;
protected
procedure ResetToDefaults; virtual;
procedure UserClickedOK; virtual;
procedure IntroBackColor; virtual;
procedure FontDialog; virtual;
procedure UpdateWindow;
public
function ShowModal: Integer; virtual;
procedure ReadRegistrySettings;
constructor Create;
end;
function StoreFontStyle(Values: TFontStyles): string;
function RestoreFontStyles(Value: String): TFontStyles;
var
frmSignonConfig: TfrmSignonConfig;
strPosition, strSize: string;
InitialValues: TSignonValues;
SignonDefaults: TSignonValues;
IsSharedBroker: Boolean;
{
const
DfltWidth: integer = 794; // 631; // 611; // 608;
DfltHeight: integer = 591; // 467; // 300;
DfltIntroClr: longint = clWindow;
DfltPosition: string = '0';
DfltSize: string = '0';
DfltIntroFont: string = ''; // 'Fixedsys^8'; // 'Courier New^8';
DfltIntroFontStyle: TFontStyles = [fsBold];
DfltBackClr: integer = 0;
p:string = '[';
}
implementation
{$R *.DFM}
uses LoginFrm, fSgnonDlg, Trpcb;
procedure TfrmSignonConfig.Button1Click(Sender: TObject);
begin
// FontDialog1.Execute;
Controller.FontDialog;
end;
procedure TfrmSignonConfig.OKBtnClick(Sender: TObject);
begin
end;
{-------------- TSignonConfiguration.ReadRegistrySettings --------------
Read Signon related settings from the Registry. Substitute defaults
for missing values.
------------------------------------------------------------------}
procedure TSignonConfiguration.ReadRegistrySettings;
var
strFontStyle: String;
strFontColor: String;
strFontSettings: String;
begin
{ Test handling of Defaults }
// ShowMessage
InitialValues.SetEqual(SignonDefaults);
InitialValues.Position := '0';
InitialValues.Size := '0';
InitialValues.BackColor := clWindow;
InitialValues.TextColor := clWindowText;
{%%%%%%% Sign-on Window Position %%%%%%%}
strPosition := ReadRegDataDefault(HKCU, REG_SIGNON, 'SignonPos','');
if strPosition <> '' then
InitialValues.Position := strPosition;
{%%%%%%% Sign-on Window Size %%%%%%%}
strSize := ReadRegDataDefault(HKCU, REG_SIGNON, 'SignonSiz', '');
if strSize <> '' then
InitialValues.Size := strSize;
{%%%%%%% Intro Text Background Color %%%%%%%}
if ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroBackClr', '') <> '' then
InitialValues.BackColor := StrToInt(ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroBackClr', ''));
{%%%%%%% Intro Text Font %%%%%%%}
strFontSettings := ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroTextFont', '');
if strFontSettings <> '' then
begin
InitialValues.IntroFont := strFontSettings;
InitialValues.Font.Name := Piece(strFontSettings,U,1);
InitialValues.Font.Size := StrToInt(Piece(strFontSettings,U,2));
end;
{%%%%%%% Intro Text Color %%%%%%%}
strFontColor := ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroTextClr', '');
if strFontColor <> '' then
begin
InitialValues.TextColor := StrToInt(strFontColor);
InitialValues.Font.Color := InitialValues.TextColor;
end;
{%%%%%%% Intro Text Font Styles %%%%%%%}
strFontStyle := ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroTextStyle', '');
if strFontStyle <> '' then
begin
InitialValues.IntroFontStyles := strFontStyle;
InitialValues.Font.Style := RestoreFontStyles(strFontStyle)
end;
end;
function StoreFontStyle(Values: TFontStyles): String;
begin
Result := '';
if fsBold in Values then
Result := Result + 'B';
if FsItalic in Values then
Result := Result + 'I';
if fsUnderline in Values then
Result := Result + 'U';
if fsStrikeout in Values then
Result := Result + 'S';
end;
procedure TfrmSignonConfig.FormShow(Sender: TObject);
begin
//
end;
function RestoreFontStyles(Value: String): TFontStyles;
begin
Result := [];
if pos('B',Value) > 0 then
Result := Result + [fsBold];
if pos('I',Value) > 0 then
Result := Result + [fsItalic];
if pos('U',Value) > 0 then
Result := Result + [fsUnderline];
if pos('S',Value) > 0 then
Result := Result + [fsStrikeout];
end;
procedure TfrmSignonConfig.rgrIntroBackClrClick(Sender: TObject);
begin
Controller.IntroBackColor;
end;
function TSignonConfiguration.ShowModal: Integer;
var
ModalValue: Integer;
begin
ReadRegistrySettings;
if frmSignonConfig = nil then
frmSignonConfig := TfrmSignonConfig.Create(Application);
frmSignonConfig.Controller := Self;
OrigHelp := Application.HelpFile; // Save original helpfile.
try
Application.HelpFile := ReadRegData(HKLM, REG_BROKER, 'BrokerDr') +
'\clagent.hlp'; // Identify ConnectTo helpfile.
with frmSignonConfig do
begin
// set selections for entry to form
rgrIntroBackClr.ItemIndex := 0; // Current Background
rgrWindowPosition.ItemIndex := StrToInt(Piece(InitialValues.Position,U,1));
rgrWindowSize.ItemIndex := StrToInt(Piece(InitialValues.Size,U,1));
// initialize font values to current settings
FIntroFontValue := InitialValues.IntroFont;
FIntroTextColor := InitialValues.TextColor;
FIntroFontStyles := InitialValues.IntroFontStyles;
ShowApplicationAndFocusOK(Application);
ModalValue := frmSignonConfig.ShowModal;
if ModalValue = mrOK then // establish changes for user
begin
UserClickedOK
end
else if ModalValue = mrIgnore then // restore default values
ResetToDefaults;
end; // with SignonForm
Result := ModalValue;
finally
frmSignonConfig.Free; // Release; jli 041104
Application.HelpFile := OrigHelp; // Restore helpfile.
end;
end;
{
called if user changes selection for Background Color
selection 0 is to current value
selection 1 is to select new color
}
procedure TSignonConfiguration.IntroBackColor;
var
frmSignonDialog: TfrmSignonDialog;
OldHandle: THandle;
begin
OldHandle := GetForegroundWindow;
if frmSignonConfig.rgrIntroBackClr.ItemIndex = 1 then
begin
frmSignonDialog := TfrmSignonDialog.Create(Application);
// ShowApplicationAndFocusOK(Application);
SetForegroundWindow(frmSignonDialog.Handle);
if frmSignonDialog.ShowModal = mrOK then
FIntroBackColor := clWindow
else
begin
ShowApplicationAndFocusOK(Application);
if IsSharedBroker then
frmSignonConfig.WindowState := wsMinimized;
if frmSignonConfig.ColorDialog1.Execute then
FIntroBackColor := frmSignonConfig.ColorDialog1.Color;
frmSignonConfig.WindowState := wsNormal;
end;
end
else
FIntroBackColor := InitialValues.BackColor;
SetForegroundWindow(OldHandle);
end;
{ called if user selects to change font for signon form }
procedure TSignonConfiguration.FontDialog;
var
frmSignonDialog: TfrmSignonDialog;
OldHandle: THandle;
FFontValue: TFont;
begin
FFontValue := TFont.Create;
OldHandle := GetForegroundWindow;
try
FFontValue.Name := InitialValues.Font.Name;
FFontValue.Size := InitialValues.Font.Size;
FFontValue.Style := InitialValues.Font.Style;
FFontValue.Color := InitialValues.Font.Color;
frmSignonDialog := TfrmSignonDialog.Create(Application);
frmSignonDialog.Label1.Caption := 'Do you want to use the Default Font face and size?';
// ShowApplicationAndFocusOK(Application);
SetForegroundWindow(frmSignonDialog.Handle);
if frmSignonDialog.ShowModal = mrOK then
FFontValue := SignonDefaults.Font
else
begin
// initialize font to current values
frmSignonConfig.FontDialog1.Font.Color := InitialValues.Font.Color;
frmSignonConfig.FontDialog1.Font.Name := InitialValues.Font.Name;
frmSignonConfig.FontDialog1.Font.Size := InitialValues.Font.Size;
frmSignonConfig.FontDialog1.Font.Style := InitialValues.Font.Style;
ShowApplicationAndFocusOK(Application);
if IsSharedBroker then
frmSignonConfig.WindowState := wsMinimized;
if frmSignonConfig.FontDialog1.Execute then
FFontValue := frmSignonConfig.FontDialog1.Font;
frmSignonConfig.WindowState := wsNormal;
end;
FIntroFontValue := FFontValue.Name + U + IntToStr(FFontValue.Size);
FIntroFontStyles := StoreFontStyle(FFontValue.Style);
FIntroTextColor := FFontValue.Color;
finally
FFontValue.Free;
SetForegroundWindow(OldHandle);
end;
end;
procedure TSignonConfiguration.ResetToDefaults;
begin
if MessageDlg('Are you sure you want to reset all settings to their defaults?',
mtWarning, [mbNo, mbYes], 0) = mrYes then
begin
// P31 remove setting of default values into registry -
// remove entries from registry and use default window in app
DeleteRegData(HKCU, REG_SIGNON, 'SignonPos');
DeleteRegData(HKCU, REG_SIGNON, 'SignonSiz');
DeleteRegData(HKCU, REG_SIGNON, 'IntroBackClr');
DeleteRegData(HKCU, REG_SIGNON, 'IntroTextClr');
DeleteRegData(HKCU, REG_SIGNON, 'IntroTextFont');
DeleteRegData(HKCU, REG_SIGNON, 'IntroTextStyle');
strPosition := '0';
strSize := '0';
// Restore values to Defaults at Signon
InitialValues.SetEqual(SignonDefaults);
UpdateWindow;
end;
end;
procedure TSignonConfiguration.UserClickedOK;
var
JPosition: Integer;
JSize: Integer;
begin
JPosition := frmSignonConfig.rgrWindowPosition.ItemIndex;
JSize := frmSignonConfig.rgrWindowSize.ItemIndex;
if JPosition = 0 then
FPosition := '0'
else
FPosition := IntToStr(JPosition)+U+IntToStr(frmSignon.Top)+U+IntToStr(frmSignon.Left);
strPosition := FPosition;
if JSize = 0 then
FSize := '0'
else
FSize := IntToStr(JSize)+U+IntToStr(frmSignon.Width)+U+IntToStr(frmSignon.Height);
strSize := FSize;
if FIntroBackColor <> InitialValues.BackColor then
begin
InitialValues.BackColor := FIntroBackColor;
if InitialValues.BackColor <> SignonDefaults.BackColor then
WriteRegData(HKCU, REG_SIGNON, 'IntroBackClr',IntToStr(FIntroBackColor))
else
DeleteRegData(HKCU, REG_SIGNON, 'IntroBackClr');
end;
if FIntroTextColor <> InitialValues.TextColor then
begin
InitialValues.TextColor := FIntroTextColor;
if InitialValues.BackColor <> SignonDefaults.BackColor then
WriteRegData(HKCU, REG_SIGNON, 'IntroTextClr',IntToStr(FIntroTextColor))
else
DeleteRegData(HKCU, REG_SIGNON, 'IntroTextClr');
end;
if FIntroFontValue <> InitialValues.IntroFont then
begin
InitialValues.IntroFont := FIntrofontValue;
if InitialValues.IntroFont <> SignonDefaults.IntroFont then
WriteRegData(HKCU, REG_SIGNON, 'IntroTextFont',FIntroFontValue)
else
DeleteRegData(HKCU, REG_SIGNON, 'IntroTextFont');
end;
if FIntroFontStyles <> InitialValues.IntroFontStyles then
begin
InitialValues.IntroFontStyles := FIntrofontStyles;
if InitialValues.IntroFontStyles <> SignonDefaults.IntroFontStyles then
WriteRegData(HKCU, REG_SIGNON, 'IntroTextStyle',FIntroFontStyles)
else
DeleteRegData(HKCU, REG_SIGNON, 'IntroTextStyle');
end;
if FPosition <> InitialValues.Position then
begin
InitialValues.Position := FPosition;
if InitialValues.Position <> SignonDefaults.Position then
WriteRegData(HKCU, REG_SIGNON, 'SignonPos',FPosition)
else
DeleteRegData(HKCU, REG_SIGNON, 'SignonPos');
end;
if FSize <> InitialValues.Size then
begin
InitialValues.Size := FSize;
if InitialValues.Size <> SignonDefaults.Size then
WriteRegData(HKCU, REG_SIGNON, 'SignonSiz',FSize)
else
DeleteRegData(HKCU, REG_SIGNON, 'SignonSiz');
end;
UpdateWindow;
end;
constructor TSignonConfiguration.Create;
begin
inherited;
if SignonDefaults = nil then
SignonDefaults := TSignonValues.Create;
if InitialValues = nil then
InitialValues := TSignonValues.Create;
end;
procedure TSignonConfiguration.UpdateWindow;
begin
// TODO -cMM: default body inserted
frmSignon.IntroText.Color := InitialValues.BackColor;
frmSignon.IntroText.Font.Name := InitialValues.Font.Name;
frmSignon.IntroText.Font.Size := InitialValues.Font.Size;
frmSignon.IntroText.Font.Style := InitialValues.Font.Style;
frmSignon.IntroText.Font.Color := InitialValues.Font.Color;
frmSignon.Left := SignonDefaults.Left;
frmSignon.Top := SignonDefaults.Top;
frmSignon.Width := SignonDefaults.Width;
frmSignon.Height := SignonDefaults.Height;
end;
procedure TSignonValues.Clear;
begin
FHeight := 0;
FWidth := 0;
FTextColor := clWindowText;
FPosition := '';
FSize := '';
FIntroFont := '';
FIntroFontStyles := '';
FBackColor := clWindow;
FFont.Name := 'Courier New' ;
FFont.Size := 11;
FFont.Style := [];
end;
constructor TSignonValues.Create;
begin
inherited;
FFont := TFont.Create;
end;
destructor TSignonValues.Destroy;
begin
FFont.Free;
inherited;
end;
procedure TSignonValues.SetSize(const Value: String);
begin
FSize := Value;
if Value <> '0' then
begin
FWidth := StrToInt(Piece(Value,U,2));
FHeight := StrToInt(Piece(Value,U,3));
end;
end;
procedure TSignonValues.SetPosition(const Value: String);
begin
FPosition := Value;
if Value <> '0' then
begin
FTop := StrToInt(Piece(Value,U,2));
FLeft := StrToInt(Piece(Value,U,3));
end;
end;
procedure TSignonValues.SetIntroFont(const Value: String);
begin
FIntroFont := Value;
FFont.Name := Piece(Value,U,1);
FFont.Size := StrToInt(Piece(Value,U,2));
end;
procedure TSignonValues.SetIntroFontStyles(const Value: String);
begin
FIntroFontStyles := Value;
if Value <> '' then
FFont.Style := RestoreFontStyles(Value)
else
FFont.Style := [];
end;
procedure TSignonValues.SetEqual(EqualToValue: TSignonValues);
begin
BackColor := EqualToValue.BackColor;
Font.Name := EqualToValue.Font.Name;
Font.Size := EqualToValue.Font.Size;
FontStyles := EqualToValue.FontStyles;
Height := EqualToValue.Height;
IntroFont := EqualToValue.IntroFont;
IntroFontStyles := EqualToValue.IntroFontStyles;
Left := EqualToValue.Left;
Position := EqualToValue.Position;
Size := EqualToValue.Size;
TextColor := EqualToValue.TextColor;
Top := EqualToValue.Top;
Width := EqualToValue.Width;
end;
procedure TSignonValues.SetFont(Value: TFont);
begin
FFont := Value;
FIntroFont := Value.Name+U+IntToStr(Value.Size);
FIntroFontStyles := StoreFontStyle(FFont.Style)
end;
procedure TSignonValues.SetTextColor(Value: LongInt);
begin
FTextColor := Value;
FFont.Color := Value;
end;
end.