source: cprs/trunk/BDK50/BDK32_P50/Source/SgnonCnf.pas@ 1687

Last change on this file since 1687 was 1678, checked in by healthsevak, 10 years ago

Added this new version of Broker component libraries while updating the working copy to CPRS version 28
File size: 19.0 KB
RevLine 
[1678]1{ **************************************************************
2 Package: XWB - Kernel RPCBroker
3 Date Created: Sept 18, 1997 (Version 1.1)
4 Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
5 Developers: Danila Manapsal, Don Craven, Joel Ivey
6 Description: Signon Form Configuration Dialog.
7 Current Release: Version 1.1 Patch 47 (Jun. 17, 2008))
8*************************************************************** }
9
10{**************************************************
111.1P31 - Modified to store signon configuration under
12 the HKCU key - this permits users on NT2000
13 machines who have USER access to set their
14 configuration. Also, makes configuration specific
15 to users on machines which might be shared.
16
17 Also make it so that configuration is only written
18 to the registry when the user indicates that it
19 should be saved (previously the default values
20 were written into the registry as well as applied
21 to the window if data was not in the registry).
22 The default values previously stored in the registry
23 would override any changes in the signon window
24 design via coding. To overcome this, if the user
25 does not have saved configuration data, the window
26 generated on opening will be used as the default, and
27 the default data written into the registry as defaults.
28 This will permit the user to restore to the current
29 window defaults if desired, but will not overwrite
30 changes released for the window in later patches.
31************************************************************}
32
33unit Sgnoncnf;
34
35interface
36
37uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
38 StdCtrls, ExtCtrls, Dialogs, SysUtils, MFunStr, XWBut1;
39
40type
41 TSignonValues = class(TObject)
42 private
43 FHeight: Integer;
44 FWidth: Integer;
45 FTextColor: LongInt;
46 FPosition: String;
47 FSize: String;
48 FIntroFont: String;
49 FIntroFontStyles: String;
50 FBackColor: LongInt;
51 FFont: TFont;
52 FFontStyles: TFontStyles;
53 FTop: Integer;
54 FLeft: Integer;
55 procedure SetSize(const Value: String);
56 procedure SetPosition(const Value: String);
57 procedure SetIntroFont(const Value: String);
58 procedure SetIntroFontStyles(const Value: String);
59 procedure SetFont(Value: TFont);
60 procedure SetTextColor(Value: LongInt);
61 public
62 procedure Clear; virtual;
63 constructor Create;
64 destructor Destroy; override;
65 procedure SetEqual(EqualToValue: TSignonValues);
66 property Height: Integer read FHeight write FHeight;
67 property Width: Integer read FWidth write FWidth;
68 property TextColor: LongInt read FTextColor write SetTextColor;
69 property Position: String read FPosition write SetPosition;
70 property Size: String read FSize write SetSize;
71 property IntroFont: String read FIntroFont write SetIntroFont;
72 property IntroFontStyles: String read FIntroFontStyles write SetIntroFontStyles;
73 property BackColor: LongInt read FBackColor write FBackColor;
74 property Font: TFont read FFont write SetFont;
75 property FontStyles: TFontStyles read FFontStyles write FFontStyles;
76 property Top: Integer read FTop write FTop;
77 property Left: Integer read FLeft write FLeft;
78 end;
79
80 TSignonConfiguration = class;
81
82{
83 This class is the form shown for configuration of the signon form
84}
85 TfrmSignonConfig = class(TForm)
86 OKBtn: TBitBtn;
87 CancelBtn: TBitBtn;
88 HelpBtn: TBitBtn;
89 Bevel1: TBevel;
90 rgrWindowPosition: TRadioGroup;
91 rgrWindowSize: TRadioGroup;
92 FontDialog1: TFontDialog;
93 GroupBox1: TGroupBox;
94 Button1: TButton;
95 btnDefaults: TBitBtn;
96 rgrIntroBackClr: TRadioGroup;
97 ColorDialog1: TColorDialog;
98 procedure Button1Click(Sender: TObject);
99 procedure OKBtnClick(Sender: TObject);
100 procedure FormShow(Sender: TObject);
101 procedure rgrIntroBackClrClick(Sender: TObject);
102 private
103 { Private declarations }
104 FController: TSignonConfiguration;
105 public
106 property Controller: TSignonConfiguration read FController write FController;
107 { Public declarations }
108 end;
109
110{
111 This class handles the processing for signon configuration
112}
113 TSignonConfiguration = class(TObject)
114 private
115 OrigHelp: String;
116 FIntroBackColor: LongInt;
117 FIntroFontValue: String;
118 FIntroFontStyles: String;
119 FIntroTextColor: LongInt;
120 FPosition: String;
121 FSize: String;
122 protected
123 procedure ResetToDefaults; virtual;
124 procedure UserClickedOK; virtual;
125 procedure IntroBackColor; virtual;
126 procedure FontDialog; virtual;
127 procedure UpdateWindow;
128 public
129 function ShowModal: Integer; virtual;
130 procedure ReadRegistrySettings;
131 constructor Create;
132 end;
133
134function StoreFontStyle(Values: TFontStyles): string;
135function RestoreFontStyles(Value: String): TFontStyles;
136
137
138var
139 frmSignonConfig: TfrmSignonConfig;
140 strPosition, strSize: string;
141 InitialValues: TSignonValues;
142 SignonDefaults: TSignonValues;
143 IsSharedBroker: Boolean;
144
145{
146const
147 DfltWidth: integer = 794; // 631; // 611; // 608;
148 DfltHeight: integer = 591; // 467; // 300;
149 DfltIntroClr: longint = clWindow;
150 DfltPosition: string = '0';
151 DfltSize: string = '0';
152 DfltIntroFont: string = ''; // 'Fixedsys^8'; // 'Courier New^8';
153 DfltIntroFontStyle: TFontStyles = [fsBold];
154 DfltBackClr: integer = 0;
155 p:string = '[';
156}
157
158implementation
159
160{$R *.DFM}
161
162uses LoginFrm, fSgnonDlg, Trpcb;
163
164procedure TfrmSignonConfig.Button1Click(Sender: TObject);
165begin
166// FontDialog1.Execute;
167 Controller.FontDialog;
168end;
169
170procedure TfrmSignonConfig.OKBtnClick(Sender: TObject);
171begin
172
173end;
174
175{-------------- TSignonConfiguration.ReadRegistrySettings --------------
176Read Signon related settings from the Registry. Substitute defaults
177for missing values.
178------------------------------------------------------------------}
179procedure TSignonConfiguration.ReadRegistrySettings;
180var
181 strFontStyle: String;
182 strFontColor: String;
183 strFontSettings: String;
184begin
185 { Test handling of Defaults }
186// ShowMessage
187 InitialValues.SetEqual(SignonDefaults);
188 InitialValues.Position := '0';
189 InitialValues.Size := '0';
190 InitialValues.BackColor := clWindow;
191 InitialValues.TextColor := clWindowText;
192
193 {%%%%%%% Sign-on Window Position %%%%%%%}
194 strPosition := ReadRegDataDefault(HKCU, REG_SIGNON, 'SignonPos','');
195 if strPosition <> '' then
196 InitialValues.Position := strPosition;
197
198 {%%%%%%% Sign-on Window Size %%%%%%%}
199 strSize := ReadRegDataDefault(HKCU, REG_SIGNON, 'SignonSiz', '');
200 if strSize <> '' then
201 InitialValues.Size := strSize;
202
203 {%%%%%%% Intro Text Background Color %%%%%%%}
204 if ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroBackClr', '') <> '' then
205 InitialValues.BackColor := StrToInt(ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroBackClr', ''));
206
207 {%%%%%%% Intro Text Font %%%%%%%}
208 strFontSettings := ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroTextFont', '');
209 if strFontSettings <> '' then
210 begin
211 InitialValues.IntroFont := strFontSettings;
212 InitialValues.Font.Name := Piece(strFontSettings,U,1);
213 InitialValues.Font.Size := StrToInt(Piece(strFontSettings,U,2));
214 end;
215
216 {%%%%%%% Intro Text Color %%%%%%%}
217 strFontColor := ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroTextClr', '');
218 if strFontColor <> '' then
219 begin
220 InitialValues.TextColor := StrToInt(strFontColor);
221 InitialValues.Font.Color := InitialValues.TextColor;
222 end;
223
224 {%%%%%%% Intro Text Font Styles %%%%%%%}
225 strFontStyle := ReadRegDataDefault(HKCU, REG_SIGNON, 'IntroTextStyle', '');
226 if strFontStyle <> '' then
227 begin
228 InitialValues.IntroFontStyles := strFontStyle;
229 InitialValues.Font.Style := RestoreFontStyles(strFontStyle)
230 end;
231end;
232
233
234function StoreFontStyle(Values: TFontStyles): String;
235begin
236 Result := '';
237 if fsBold in Values then
238 Result := Result + 'B';
239 if FsItalic in Values then
240 Result := Result + 'I';
241 if fsUnderline in Values then
242 Result := Result + 'U';
243 if fsStrikeout in Values then
244 Result := Result + 'S';
245end;
246
247procedure TfrmSignonConfig.FormShow(Sender: TObject);
248begin
249 //
250end;
251
252function RestoreFontStyles(Value: String): TFontStyles;
253begin
254 Result := [];
255 if pos('B',Value) > 0 then
256 Result := Result + [fsBold];
257 if pos('I',Value) > 0 then
258 Result := Result + [fsItalic];
259 if pos('U',Value) > 0 then
260 Result := Result + [fsUnderline];
261 if pos('S',Value) > 0 then
262 Result := Result + [fsStrikeout];
263end;
264
265procedure TfrmSignonConfig.rgrIntroBackClrClick(Sender: TObject);
266begin
267 Controller.IntroBackColor;
268end;
269
270function TSignonConfiguration.ShowModal: Integer;
271var
272 ModalValue: Integer;
273begin
274 ReadRegistrySettings;
275 if frmSignonConfig = nil then
276 frmSignonConfig := TfrmSignonConfig.Create(Application);
277 frmSignonConfig.Controller := Self;
278 OrigHelp := Application.HelpFile; // Save original helpfile.
279 try
280 Application.HelpFile := ReadRegData(HKLM, REG_BROKER, 'BrokerDr') +
281 '\clagent.hlp'; // Identify ConnectTo helpfile.
282 with frmSignonConfig do
283 begin
284 // set selections for entry to form
285 rgrIntroBackClr.ItemIndex := 0; // Current Background
286 rgrWindowPosition.ItemIndex := StrToInt(Piece(InitialValues.Position,U,1));
287 rgrWindowSize.ItemIndex := StrToInt(Piece(InitialValues.Size,U,1));
288 // initialize font values to current settings
289 FIntroFontValue := InitialValues.IntroFont;
290 FIntroTextColor := InitialValues.TextColor;
291 FIntroFontStyles := InitialValues.IntroFontStyles;
292
293 ShowApplicationAndFocusOK(Application);
294 ModalValue := frmSignonConfig.ShowModal;
295 if ModalValue = mrOK then // establish changes for user
296 begin
297 UserClickedOK
298 end
299 else if ModalValue = mrIgnore then // restore default values
300 ResetToDefaults;
301 end; // with SignonForm
302 Result := ModalValue;
303 finally
304 frmSignonConfig.Free; // Release; jli 041104
305 Application.HelpFile := OrigHelp; // Restore helpfile.
306 end;
307end;
308
309{
310 called if user changes selection for Background Color
311 selection 0 is to current value
312 selection 1 is to select new color
313}
314procedure TSignonConfiguration.IntroBackColor;
315var
316 frmSignonDialog: TfrmSignonDialog;
317 OldHandle: THandle;
318begin
319 OldHandle := GetForegroundWindow;
320 if frmSignonConfig.rgrIntroBackClr.ItemIndex = 1 then
321 begin
322 frmSignonDialog := TfrmSignonDialog.Create(Application);
323// ShowApplicationAndFocusOK(Application);
324 SetForegroundWindow(frmSignonDialog.Handle);
325 if frmSignonDialog.ShowModal = mrOK then
326 FIntroBackColor := clWindow
327 else
328 begin
329 ShowApplicationAndFocusOK(Application);
330 if IsSharedBroker then
331 frmSignonConfig.WindowState := wsMinimized;
332 if frmSignonConfig.ColorDialog1.Execute then
333 FIntroBackColor := frmSignonConfig.ColorDialog1.Color;
334 frmSignonConfig.WindowState := wsNormal;
335 end;
336 end
337 else
338 FIntroBackColor := InitialValues.BackColor;
339 SetForegroundWindow(OldHandle);
340end;
341
342{ called if user selects to change font for signon form }
343procedure TSignonConfiguration.FontDialog;
344var
345 frmSignonDialog: TfrmSignonDialog;
346 OldHandle: THandle;
347 FFontValue: TFont;
348begin
349 FFontValue := TFont.Create;
350 OldHandle := GetForegroundWindow;
351 try
352 FFontValue.Name := InitialValues.Font.Name;
353 FFontValue.Size := InitialValues.Font.Size;
354 FFontValue.Style := InitialValues.Font.Style;
355 FFontValue.Color := InitialValues.Font.Color;
356 frmSignonDialog := TfrmSignonDialog.Create(Application);
357 frmSignonDialog.Label1.Caption := 'Do you want to use the Default Font face and size?';
358 // ShowApplicationAndFocusOK(Application);
359
360 SetForegroundWindow(frmSignonDialog.Handle);
361 if frmSignonDialog.ShowModal = mrOK then
362 FFontValue := SignonDefaults.Font
363 else
364 begin
365 // initialize font to current values
366 frmSignonConfig.FontDialog1.Font.Color := InitialValues.Font.Color;
367 frmSignonConfig.FontDialog1.Font.Name := InitialValues.Font.Name;
368 frmSignonConfig.FontDialog1.Font.Size := InitialValues.Font.Size;
369 frmSignonConfig.FontDialog1.Font.Style := InitialValues.Font.Style;
370 ShowApplicationAndFocusOK(Application);
371 if IsSharedBroker then
372 frmSignonConfig.WindowState := wsMinimized;
373 if frmSignonConfig.FontDialog1.Execute then
374 FFontValue := frmSignonConfig.FontDialog1.Font;
375 frmSignonConfig.WindowState := wsNormal;
376 end;
377 FIntroFontValue := FFontValue.Name + U + IntToStr(FFontValue.Size);
378 FIntroFontStyles := StoreFontStyle(FFontValue.Style);
379 FIntroTextColor := FFontValue.Color;
380 finally
381 FFontValue.Free;
382 SetForegroundWindow(OldHandle);
383 end;
384end;
385
386procedure TSignonConfiguration.ResetToDefaults;
387begin
388 if MessageDlg('Are you sure you want to reset all settings to their defaults?',
389 mtWarning, [mbNo, mbYes], 0) = mrYes then
390 begin
391 // P31 remove setting of default values into registry -
392 // remove entries from registry and use default window in app
393 DeleteRegData(HKCU, REG_SIGNON, 'SignonPos');
394 DeleteRegData(HKCU, REG_SIGNON, 'SignonSiz');
395 DeleteRegData(HKCU, REG_SIGNON, 'IntroBackClr');
396 DeleteRegData(HKCU, REG_SIGNON, 'IntroTextClr');
397 DeleteRegData(HKCU, REG_SIGNON, 'IntroTextFont');
398 DeleteRegData(HKCU, REG_SIGNON, 'IntroTextStyle');
399 strPosition := '0';
400 strSize := '0';
401 // Restore values to Defaults at Signon
402 InitialValues.SetEqual(SignonDefaults);
403
404 UpdateWindow;
405 end;
406end;
407
408procedure TSignonConfiguration.UserClickedOK;
409var
410 JPosition: Integer;
411 JSize: Integer;
412begin
413 JPosition := frmSignonConfig.rgrWindowPosition.ItemIndex;
414 JSize := frmSignonConfig.rgrWindowSize.ItemIndex;
415
416 if JPosition = 0 then
417 FPosition := '0'
418 else
419 FPosition := IntToStr(JPosition)+U+IntToStr(frmSignon.Top)+U+IntToStr(frmSignon.Left);
420 strPosition := FPosition;
421
422 if JSize = 0 then
423 FSize := '0'
424 else
425 FSize := IntToStr(JSize)+U+IntToStr(frmSignon.Width)+U+IntToStr(frmSignon.Height);
426 strSize := FSize;
427
428 if FIntroBackColor <> InitialValues.BackColor then
429 begin
430 InitialValues.BackColor := FIntroBackColor;
431 if InitialValues.BackColor <> SignonDefaults.BackColor then
432 WriteRegData(HKCU, REG_SIGNON, 'IntroBackClr',IntToStr(FIntroBackColor))
433 else
434 DeleteRegData(HKCU, REG_SIGNON, 'IntroBackClr');
435 end;
436
437 if FIntroTextColor <> InitialValues.TextColor then
438 begin
439 InitialValues.TextColor := FIntroTextColor;
440 if InitialValues.BackColor <> SignonDefaults.BackColor then
441 WriteRegData(HKCU, REG_SIGNON, 'IntroTextClr',IntToStr(FIntroTextColor))
442 else
443 DeleteRegData(HKCU, REG_SIGNON, 'IntroTextClr');
444 end;
445
446 if FIntroFontValue <> InitialValues.IntroFont then
447 begin
448 InitialValues.IntroFont := FIntrofontValue;
449 if InitialValues.IntroFont <> SignonDefaults.IntroFont then
450 WriteRegData(HKCU, REG_SIGNON, 'IntroTextFont',FIntroFontValue)
451 else
452 DeleteRegData(HKCU, REG_SIGNON, 'IntroTextFont');
453 end;
454
455 if FIntroFontStyles <> InitialValues.IntroFontStyles then
456 begin
457 InitialValues.IntroFontStyles := FIntrofontStyles;
458 if InitialValues.IntroFontStyles <> SignonDefaults.IntroFontStyles then
459 WriteRegData(HKCU, REG_SIGNON, 'IntroTextStyle',FIntroFontStyles)
460 else
461 DeleteRegData(HKCU, REG_SIGNON, 'IntroTextStyle');
462 end;
463
464 if FPosition <> InitialValues.Position then
465 begin
466 InitialValues.Position := FPosition;
467 if InitialValues.Position <> SignonDefaults.Position then
468 WriteRegData(HKCU, REG_SIGNON, 'SignonPos',FPosition)
469 else
470 DeleteRegData(HKCU, REG_SIGNON, 'SignonPos');
471 end;
472
473 if FSize <> InitialValues.Size then
474 begin
475 InitialValues.Size := FSize;
476 if InitialValues.Size <> SignonDefaults.Size then
477 WriteRegData(HKCU, REG_SIGNON, 'SignonSiz',FSize)
478 else
479 DeleteRegData(HKCU, REG_SIGNON, 'SignonSiz');
480 end;
481
482 UpdateWindow;
483end;
484
485constructor TSignonConfiguration.Create;
486begin
487 inherited;
488 if SignonDefaults = nil then
489 SignonDefaults := TSignonValues.Create;
490 if InitialValues = nil then
491 InitialValues := TSignonValues.Create;
492
493end;
494
495procedure TSignonConfiguration.UpdateWindow;
496begin
497 // TODO -cMM: default body inserted
498 frmSignon.IntroText.Color := InitialValues.BackColor;
499 frmSignon.IntroText.Font.Name := InitialValues.Font.Name;
500 frmSignon.IntroText.Font.Size := InitialValues.Font.Size;
501 frmSignon.IntroText.Font.Style := InitialValues.Font.Style;
502 frmSignon.IntroText.Font.Color := InitialValues.Font.Color;
503 frmSignon.Left := SignonDefaults.Left;
504 frmSignon.Top := SignonDefaults.Top;
505 frmSignon.Width := SignonDefaults.Width;
506 frmSignon.Height := SignonDefaults.Height;
507end;
508
509procedure TSignonValues.Clear;
510begin
511 FHeight := 0;
512 FWidth := 0;
513 FTextColor := clWindowText;
514 FPosition := '';
515 FSize := '';
516 FIntroFont := '';
517 FIntroFontStyles := '';
518 FBackColor := clWindow;
519 FFont.Name := 'Courier New' ;
520 FFont.Size := 11;
521 FFont.Style := [];
522end;
523
524constructor TSignonValues.Create;
525begin
526 inherited;
527 FFont := TFont.Create;
528end;
529
530destructor TSignonValues.Destroy;
531begin
532 FFont.Free;
533 inherited;
534end;
535
536procedure TSignonValues.SetSize(const Value: String);
537begin
538 FSize := Value;
539 if Value <> '0' then
540 begin
541 FWidth := StrToInt(Piece(Value,U,2));
542 FHeight := StrToInt(Piece(Value,U,3));
543 end;
544end;
545
546procedure TSignonValues.SetPosition(const Value: String);
547begin
548 FPosition := Value;
549 if Value <> '0' then
550 begin
551 FTop := StrToInt(Piece(Value,U,2));
552 FLeft := StrToInt(Piece(Value,U,3));
553 end;
554end;
555
556procedure TSignonValues.SetIntroFont(const Value: String);
557begin
558 FIntroFont := Value;
559 FFont.Name := Piece(Value,U,1);
560 FFont.Size := StrToInt(Piece(Value,U,2));
561end;
562
563procedure TSignonValues.SetIntroFontStyles(const Value: String);
564begin
565 FIntroFontStyles := Value;
566 if Value <> '' then
567 FFont.Style := RestoreFontStyles(Value)
568 else
569 FFont.Style := [];
570end;
571
572procedure TSignonValues.SetEqual(EqualToValue: TSignonValues);
573begin
574 BackColor := EqualToValue.BackColor;
575 Font.Name := EqualToValue.Font.Name;
576 Font.Size := EqualToValue.Font.Size;
577 FontStyles := EqualToValue.FontStyles;
578 Height := EqualToValue.Height;
579 IntroFont := EqualToValue.IntroFont;
580 IntroFontStyles := EqualToValue.IntroFontStyles;
581 Left := EqualToValue.Left;
582 Position := EqualToValue.Position;
583 Size := EqualToValue.Size;
584 TextColor := EqualToValue.TextColor;
585 Top := EqualToValue.Top;
586 Width := EqualToValue.Width;
587end;
588
589procedure TSignonValues.SetFont(Value: TFont);
590begin
591 FFont := Value;
592 FIntroFont := Value.Name+U+IntToStr(Value.Size);
593 FIntroFontStyles := StoreFontStyle(FFont.Style)
594end;
595
596procedure TSignonValues.SetTextColor(Value: LongInt);
597begin
598 FTextColor := Value;
599 FFont.Color := Value;
600end;
601
602end.
Note: See TracBrowser for help on using the repository browser.