Summary Table
Categories |
Total Count |
PII |
0 |
URL |
0 |
DNS |
0 |
EKL |
0 |
IP |
0 |
PORT |
0 |
VsID |
0 |
CF |
0 |
AI |
0 |
VPD |
0 |
PL |
0 |
Other |
0 |
File Content
{ **************************************************************
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: Contains TRPCBroker and related components.
Unit: SgnonCnf Signon Form configuration dialog.
Current Release: Version 1.1 Patch 65
*************************************************************** }
{ **************************************************
Changes in v1.1.65 (HGW 08/05/2015 ) XWB*1.1*65
1. None.
Changes in v1.1.60 (HGW 05/08/2014 ) XWB*1.1*60
1. None. Windows Registry access errors resolved in Xwbut1.pas.
Changes in v1.1.31 (DCM ) XWB*1.1*31
1. 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 user on
machines which might be shared.
2. 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
{System}
Classes, SysUtils, UITypes,
{WinApi}
WinTypes, WinProcs,
{VA}
MFunStr, XWBut1,
{Vcl}
Graphics, Forms, Controls, Buttons, StdCtrls, ExtCtrls, Dialogs;
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;
implementation
{$R *.DFM}
uses
{VA}
Loginfrm, fSgnonDlg, Trpcb;
procedure TfrmSignonConfig.Button1Click(Sender: TObject);
begin
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 }
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.