formsettings.pas

能够监视另一台机子的屏幕

unit FormSettings;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Registry, StdCtrls;

type
   TSaveValOpt = (svEdit, svMemo, svCheckBox, svRadioButton, svListBox,
      svComboBox, svFontDialog);
   TSaveValSet = set of TSaveValOpt;

   TFormSettings = class(TComponent)
   protected
      FSavePos    : boolean;
      FSaveVals   : boolean;
      FLoadVals   : boolean;
      FKeyName    : string;
      FSaveOpt    : TSaveValSet;
      FRootCon    : TWinControl;
      DidLastSave : boolean;
      procedure   Loaded; override;
      function    StrToWS(const s: string): TWindowState;
      function    WSToStr(ws: TWindowState): string;
      function    GetKeyName: string;
      procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
      procedure   DoLoadValues(reg: TRegIniFile);
      procedure   DoSaveValues(reg: TRegIniFile);
      procedure   ReadFont(Name: string; f: TFont; reg: TRegIniFile);
      procedure   WriteFont(Name: string; f: TFont; reg: TRegIniFile);
   public
      constructor Create(AOwner: TComponent); override;
      destructor  Destroy; override;
      procedure   LoadSettings;
      procedure   SaveSettings;
   published
      property    SavePosition: boolean read FSavePos write FSavePos;
      property    SaveValues: boolean read FSaveVals write FSaveVals;
      property    LoadValues: boolean read FLoadVals write FLoadVals;
      property    SaveValueOptions: TSaveValSet read FSaveOpt write FSaveOpt;
      property    KeyName: string read GetKeyName write FKeyName;
      property    RootControl: TWinControl read FRootCon write FRootCon;
   end;

procedure Register;

implementation

const
   WindowStr : array[1..3] of string = ('NORMAL', 'MAXIMIZED', 'MINIMIZED');


constructor TFormSettings.Create(AOwner: TComponent);
begin
   inherited;
   FreeNotification(AOwner);
   FSavePos    := True;
   FSaveVals   := False;
   FLoadVals   := False;
   DidLastSave := False;
   FSaveOpt := [svEdit, svMemo, svCheckBox, svRadioButton, svListBox,
      svComboBox, svFontDialog];
end;

destructor TFormSettings.Destroy;
begin
   inherited;
end;

procedure TFormSettings.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited;
   if (not DidLastSave) and (csDestroying in ComponentState) then begin
      DidLastSave := True;
      // This still doesn't work!  All the window handles are gone! -bpz
      // SaveSettings;
   end;
end;

procedure TFormSettings.Loaded;
begin
   inherited;
   LoadSettings;
end;

function TFormSettings.StrToWS(const s: string): TWindowState;
var
   t : string;
begin
   t := UpperCase(s);
   Result := wsNormal;
   if t = WindowStr[1] then Result := wsNormal;
   if t = WindowStr[2] then Result := wsMaximized;
   if t = WindowStr[3] then Result := wsMinimized;
end;

function TFormSettings.WSToStr(ws: TWindowState): string;
begin
   case ws of
      wsNormal    : Result := WindowStr[1];
      wsMaximized : Result := WindowStr[2];
      wsMinimized : Result := WIndowStr[3];
   else
      Result := WindowStr[1];
   end;
end;

function TFormSettings.GetKeyName: string;
begin
   Result := FKeyName;

   if (Result='') and (not (csDesigning in ComponentState))
      and (Application<>nil) and (Owner<>nil) then
      Result := 'Software\' + Application.Title + '\' + Owner.Name;
end;

procedure TFormSettings.LoadSettings;
var
   f   : TForm;
   reg : TRegIniFile;
begin
   if (Owner = nil) or (not (Owner is TForm)) then exit;
   if csDesigning in ComponentState then exit;

   f := Owner as TForm;
   f.Position := poDesigned;

   reg := TRegIniFile.Create(KeyName);

   if SavePosition then begin
      f.Left        := reg.ReadInteger('Position', 'Left', f.Left);
      f.Top         := reg.ReadInteger('Position', 'Top', f.Top);
      f.Width       := reg.ReadInteger('Position', 'Width', f.Width);
      f.Height      := reg.ReadInteger('Position', 'Height', f.Height);
      f.WindowState := StrToWS(reg.ReadString('Position', 'WindowState', 'Normal'));
   end;

   if LoadValues then
      DoLoadValues(reg);

   reg.Free;
end;

procedure TFormSettings.SaveSettings;
var
   f   : TForm;
   reg : TRegIniFile;
begin
   if (Owner = nil) or (not (Owner is TForm)) then exit;
   if csDesigning in ComponentState then exit;

   f := Owner as TForm;
   f.Position := poDesigned;

   reg := TRegIniFile.Create(KeyName);

   if SavePosition then begin
      if f.WindowState = wsNormal then begin
         reg.WriteInteger('Position', 'Left', f.Left);
         reg.WriteInteger('Position', 'Top', f.Top);
         reg.WriteInteger('Position', 'Width', f.Width);
         reg.WriteInteger('Position', 'Height', f.Height);
      end;
      reg.WriteString('Position', 'WindowState', WSToStr(f.WindowState));
   end;

   if SaveValues then
      DoSaveValues(reg);

   reg.Free;
end;

procedure TFormSettings.DoLoadValues(reg: TRegIniFile);
var
   i     : integer;
   con   : TWinControl;
   c     : TControl;
   cp    : TComponent;
begin
   con := RootControl;
   if con=nil then con := Owner as TForm;
   Assert(con<>nil);

   for i := 0 to con.ComponentCount-1 do begin
      cp := con.Components[i];
      if not (cp is TControl) then continue;
      c := cp as TControl;

      if c is TEdit then
         TEdit(c).Text := reg.ReadString('Values', c.Name, TEdit(c).Text);
      if c is TMemo then
         TMemo(c).Text := reg.ReadString('Values', c.Name, TMemo(c).Text);
      if c is TCheckBox then
         TCheckBox(c).Checked := reg.ReadBool('Values', c.Name, TCheckBox(c).Checked);
      if c is TRadioButton then
         TRadioButton(c).Checked := reg.ReadBool('Values', c.Name, TRadioButton(c).Checked);
      if c is TListBox then
         TListBox(c).ItemIndex := reg.ReadInteger('Values', c.Name, TListBox(c).ItemIndex);
      if c is TComboBox then
         TComboBox(c).ItemIndex := reg.ReadInteger('Values', c.Name, TComboBox(c).ItemIndex);
   end;

   for i := 0 to con.ComponentCount-1 do begin
      cp := con.Components[i];
      if cp is TFontDialog then
         ReadFont(cp.Name, TFontDialog(cp).Font, reg);
   end;
end;

procedure TFormSettings.DoSaveValues(reg: TRegIniFile);
var
   i     : integer;
   con   : TWinControl;
   c     : TControl;
   cp    : TComponent;
begin
   con := RootControl;
   if con=nil then con := Owner as TForm;
   Assert(con<>nil);

   for i := 0 to con.ComponentCount-1 do begin
      cp := con.Components[i];
      if not (cp is TControl) then continue;
      c := cp as TControl;

      if c is TEdit then
         reg.WriteString('Values', c.Name, TEdit(c).Text);
      if c is TMemo then
         reg.WriteString('Values', c.Name, TMemo(c).Text);
      if c is TCheckBox then
         reg.WriteBool('Values', c.Name, TCheckBox(c).Checked);
      if c is TRadioButton then
         reg.WriteBool('Values', c.Name, TRadioButton(c).Checked);
      if c is TListBox then
         reg.WriteInteger('Values', c.Name, TListBox(c).ItemIndex);
      if c is TComboBox then
         reg.WriteInteger('Values', c.Name, TComboBox(c).ItemIndex);
   end;

   for i := 0 to con.ComponentCount-1 do begin
      cp := con.Components[i];
      if cp is TFontDialog then
         WriteFont(cp.Name, TFontDialog(cp).Font, reg);
   end;
end;

procedure TFormSettings.ReadFont(Name: string; f: TFont; reg: TRegIniFile);
var
   b : boolean;
begin
   f.Name  := reg.ReadString('Values', Name + '_Name', f.Name);
   f.Size  := reg.ReadInteger('Values', Name + '_Size', f.Size);
   f.Color := reg.ReadInteger('Values', Name + '_Color', f.Color);

   b := reg.ReadBool('Values', Name + '_Bold', fsBold in f.Style);
   if b then f.Style := f.Style + [fsBold]
      else f.Style := f.Style - [fsBold];

   b := reg.ReadBool('Values', Name + '_Italic', fsItalic in f.Style);
   if b then f.Style := f.Style + [fsItalic]
      else f.Style := f.Style - [fsItalic];

   b := reg.ReadBool('Values', Name + '_Underline', fsUnderline in f.Style);
   if b then f.Style := f.Style + [fsUnderline]
      else f.Style := f.Style - [fsUnderline];

   b := reg.ReadBool('Values', Name + '_StrikeOut', fsStrikeOut in f.Style);
   if b then f.Style := f.Style + [fsStrikeOut]
      else f.Style := f.Style - [fsStrikeOut];
end;

procedure TFormSettings.WriteFont(Name: string; f: TFont; reg: TRegIniFile);
begin
   reg.WriteString('Values', Name + '_Name', f.Name);
   reg.WriteInteger('Values', Name + '_Size', f.Size);
   reg.WriteInteger('Values', Name + '_Color', f.Color);

   reg.WriteBool('Values', Name + '_Bold', fsBold in f.Style);
   reg.WriteBool('Values', Name + '_Italic', fsItalic in f.Style);
   reg.WriteBool('Values', Name + '_Underline', fsUnderline in f.Style);
   reg.WriteBool('Values', Name + '_StrikeOut', fsStrikeOut in f.Style);
end;


procedure Register;
begin
  RegisterComponents('BenTools', [TFormSettings]);
end;

end.