Сохранение состояния ВСЕХ компонентов

Delphi , Компоненты и Классы , Компоненты

Автор: Святослав
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Сохраняет состояние !!!ВСЕХ!!! компонентов (втч и вложенных, втч TYesOrNoDialog)
на форме в реестр. Знает кучу классов. Очень удобен, напримр, для руссификации приложения
(Создаете *.reg файл, с переведенными property text, caption и т.д.)

TStateSaver.RegistryPath:String - то мето в реестре, куда сохранять.
.WriteTop, .WriteLeft, .WriteHeight, ... :Boolean - сохранять ли соответствующее
Property (нет динамического списка, который можно было бы реализовать, используя
GetFieldAddress, по причине невозможности определить состояние ReadOnly :( )
property OnNewComponentSaving:TSaverEvent read _ONNC write _ONNC;
property OnNewComponentLoading:TSaverEvent read _ONNCL write _ONNCL; - event'ы
вызывающиеся при сохранении/загрузки состояния какого-то компонента.
Параметр DoIt:Boolean - сохранить/загрузить или нет.
procedure SaveComponentState(C:TComponent; preffix, postfix:String);
procedure LoadComponentState(C:TComponent; preffix, postfix:String);
-сохранить/загрузить состояние всех под-компонентов компонента C.
preffix и postfic - префикс и постфикс имени при сохранении в реестр.

Зависимости: Windows, Messages, SysUtils, Classes, Registry, Dialogs, Controls,
StdCtrls, ExtCtrls, Buttons, UBPFD.YesOrNoDialog, Menus;
Автор:       Святослав, lisin@asicdesign.ru, ICQ:138752432, Saint Petersburg
Copyright:   (C) NetBreaker666[AWD]<SP666>@Svjatoslav_Lisin - т.е. я сам
Дата:        11 августа 2002 г.
***************************************************** }

unit StateSaver;

interface

uses
  Windows, Messages, SysUtils, Classes, Registry, Dialogs, Controls, StdCtrls,
    ExtCtrls, Buttons, YesOrNoDialog, Menus;
type
  TSaverEvent = procedure(Sender: TObject; Target: TComponent; var DoIt: Boolean)
    of object;

  TStateSaver = class(TComponent)
  private
    { Private declarations }
    RegPath: string;
    RegRoot: string;
    RegRootHKEY: HKEY;
    WTOP, WLEFT, WWIDTH, WHEIGHT, WTAG: Boolean;
    WCAPTION, WTEXT, WCOLOR: Boolean;
    WEnabled, WVisible, WChecked: Boolean;
    _ONNC, _ONNCL: TSaverEvent;
    procedure SetRegRoot(S: string);
    procedure SetRegRootHKEY(HK: HKEY);
  protected

    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    property RegistryRoot: string read RegROOT write SetRegROOT;
    property RegistryRootHKEY: HKey read RegRootHKEY write SetRegRootHKEY default
      HKEY_CURRENT_USER;
    property RegistryPath: string read RegPath write RegPath;
    property WriteTop: Boolean read WTOP write WTOP;
    property WriteLeft: Boolean read WLeft write WLeft;
    property WriteWidth: Boolean read WWIDTH write WWidth;
    property WriteHeight: Boolean read WHEIGHT write WHeight;
    property WriteCaption: Boolean read WCaption write WCaption;
    property WriteText: Boolean read WText write WText;
    property WriteColor: boolean read WColor write WColor;
    property WriteTag: Boolean read WTAG write WTag;
    property WriteEnabled: Boolean read WEnabled write WEnabled;
    property WriteVisible: Boolean read WVisible write WVisible;
    property WriteChecked: Boolean read WChecked write WChecked;
    property OnNewComponentSaving: TSaverEvent read _ONNC write _ONNC;
    property OnNewComponentLoading: TSaverEvent read _ONNCL write _ONNCL;
    procedure SaveComponentState(C: TComponent; preffix, postfix: string);
    procedure LoadComponentState(C: TComponent; preffix, postfix: string);
  end;

  TUPC = class(TControl)
  public
    property Color;
    property Caption;
    property Text;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('NetBreakers', [TStateSaver]);
end;

procedure TStateSaver.SetRegRoot(S: string);
begin
  S := UpperCase(S);
  if S = 'HKEY_LOCAL_MACHINE' then
  begin
    RegRootHKEY := HKEY_LOCAL_MACHINE;
    RegRoot := S;
    Exit;
  end;
  if S = 'HKEY_CURRENT_USER' then
  begin
    RegRootHKEY := HKEY_CURRENT_USER;
    RegRoot := S;
    Exit;
  end;
  if S = 'HKEY_CLASSES_ROOT' then
  begin
    RegRootHKEY := HKEY_CLASSES_ROOT;
    RegRoot := S;
    Exit;
  end;

  if S = 'HKEY_USERS' then
  begin
    RegRootHKEY := HKEY_USERS;
    RegRoot := S;
    Exit;
  end;

  if S = 'HKEY_PERFORMANCE_DATA' then
  begin
    RegRootHKEY := HKEY_PERFORMANCE_DATA;
    RegRoot := S;
    Exit;
  end;
  if S = 'HKEY_CURRENT_CONFIG' then
  begin
    RegRootHKEY := HKEY_CURRENT_CONFIG;
    RegRoot := S;
    Exit;
  end;
  if S = 'HKEY_DYN_DATA' then
  begin
    RegRootHKEY := HKEY_DYN_DATA;
    RegRoot := S;
    Exit;
  end;

  ShowMessage('Invalid registry key.');

end;

procedure TStateSaver.SetRegRootHKEY(HK: HKEY);
begin
  case HK of
    HKEY_LOCAL_MACHINE:
      begin
        RegRoot := 'HKEY_LOCAL_MACHINE';
      end;

    HKEY_CURRENT_USER:
      begin
        RegRoot := 'HKEY_CURRENT_USER';
      end;

    HKEY_CLASSES_ROOT:
      begin
        RegRoot := 'HKEY_CLASSES_ROOT';
      end;

    HKEY_USERS:
      begin
        RegRoot := 'HKEY_USERS';
      end;

    HKEY_PERFORMANCE_DATA:
      begin
        RegRoot := 'HKEY_PERFORMANCE_DATA';
      end;

    HKEY_CURRENT_CONFIG:
      begin
        RegRoot := 'HKEY_CURRENT_CONFIG';
      end;

    HKEY_DYN_DATA:
      begin
        RegRoot := 'HKEY_DYN_DATA';
      end;
  else
    begin
      ShowMessage('Unknown registry key.');
      Exit;
    end;

  end;
  RegRootHKEY := HK;

end;

procedure TStateSaver.SaveComponentState(C: TComponent; preffix, postfix:
  string);
var
  T: TControl;
  R: TRegistry;
  I: Integer;
  CC: Boolean;
begin
  CC := True;
  if Assigned(_ONNC) then
    _ONNC(self, C, CC);
  if CC then
  begin
    if C is TControl then
    begin
      T := C as TControl;
      R := TRegistry.Create;
      R.RootKey := RegRootHKEY;
      if R.OpenKey(RegPath, True) then
      begin
        try
          if WTOP then
            R.WriteInteger(preffix + C.GetNamePath + '.TOP' + postfix, T.Top);
        except
        end;
        try
          if WEnabled then
            R.WriteBool(preffix + C.GetNamePath + '.Enabled' + postfix,
              T.Enabled);
        except
        end;
        try
          if WVisible then
            R.WriteBool(preffix + C.GetNamePath + '.TOP' + postfix, T.Visible);
        except
        end;

        try
          if WLEFT then
            R.WriteInteger(preffix + C.GetNamePath + '.LEFT' + postfix, T.Left);
        except
        end;
        try
          if WTAG then
            R.WriteInteger(preffix + C.GetNamePath + '.TAG' + postfix, T.Tag);
        except
        end;
        try
          if WHEIGHT then
            R.WriteInteger(preffix + C.GetNamePath + '.HEIGHT' + postfix,
              T.Height);
        except
        end;
        try
          if WWIDTH then
            R.WriteInteger(preffix + C.GetNamePath + '.WIDTH' + postfix,
              T.Width);
        except
        end;
        if WTEXT then
        begin
          try
            R.WriteString(preffix + C.GetNamePath + '.Text' + postfix,
              TUPC(T).Text);
          except
            try
              if T is TCustomEdit then
                R.WriteString(preffix + C.GetNamePath + '.Text' + postfix,
                  TCustomEdit(T).Text);
            except
            end;
          end;
        end;
        if WCOLOR then
        begin
          try
            R.WriteInteger(preffix + C.GetNamePath + '.Color' + postfix,
              Integer(TUPC(T).color));
          except
          end;
        end;
        if WCAPTION then
        begin
          try
            R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
              TUPC(T).caption);
          except
            try
              if T is TButton then
                R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
                  TButton(T).Caption);
              if T is TCustomLabel then
                R.WriteString(preffix + C.GetNamePath + '.caption' + postfix,
                  TCustomLabel(T).Caption);
              if T is TCheckBox then
                R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
                  TCheckBox(T).Caption);
              if T is TRadioButton then
                R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
                  TRadioButton(T).Caption);
              if T is TGroupBox then
                R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
                  TGroupBox(T).Caption);
              if T is TRadioGroup then
                R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
                  TRadioGroup(T).Caption);
              if T is TPanel then
                R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
                  TPanel(T).Caption);
              if T is TSpeedButton then
                R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
                  TSpeedButton(T).Caption);
              if T is TStaticText then
                R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
                  TStaticText(T).Caption);
            except
            end;
          end;
        end;

      end
      else
      begin
        //ShowMessage('Couldn''t open key "'+RegPath+'".');
        Exit;
      end;
      R.Free;
    end
    else
    begin
      if C is TYesOrNoDialog then
      begin
        R := TRegistry.Create;
        R.RootKey := RegRootHKEY;
        if R.OpenKey(RegPath, True) then
        begin
          if WCaption then
            R.WriteString(preffix + C.GetNamePath + '.Caption' + postfix,
              TYesOrNoDialog(C).caption);
          if WText then
            R.WriteString(preffix + C.GetNamePath + '.Text' + postfix,
              TYesOrNoDialog(C).Text);
        end;
        R.Free;
      end;
      if C is TPopupMenu then
      begin
        R := TRegistry.Create;
        R.RootKey := RegRootHKEY;
        if R.OpenKey(RegPath, True) then
        begin
          for I := 0 to TPopupMenu(C).Items.Count - 1 do
          begin
            if WCaption then
              R.WriteString(preffix + C.GetNamePath + '.Item[' + IntToStr(I) +
                '].Caption' + postfix, TPopupMenu(C).Items[I].caption);
            if WEnabled then
              R.WriteBool(preffix + C.GetNamePath + '.Item[' + IntToStr(I) +
                '].Enabled' + postfix, TPopupMenu(C).Items[I].Enabled);
            if WVisible then
              R.WriteBool(preffix + C.GetNamePath + '.Item[' + IntToStr(I) +
                '].Visible' + postfix, TPopupMenu(C).Items[I].Visible);
            if WChecked then
              R.WriteBool(preffix + C.GetNamePath + '.Item[' + IntToStr(I) +
                '].Checked' + postfix, TPopupMenu(C).Items[I].Checked);
          end;
        end;
        R.Free;
      end;

    end;

  end;
  for I := 0 to C.ComponentCount - 1 do
    SaveComponentState(C.Components[i], preffix + C.GetNamePath + '.', postfix);
end;

procedure TStateSaver.LoadComponentState(C: TComponent; preffix, postfix:
  string);
var
  T: TControl;
  R: TRegistry;
  I: Integer;
  CC: Boolean;
begin
  CC := True;
  if Assigned(_ONNCL) then
    _ONNCL(self, C, CC);
  if CC then
  begin
    if C is TControl then
    begin
      T := C as TControl;
      R := TRegistry.Create;
      R.RootKey := RegRootHKEY;
      if R.OpenKey(RegPath, False) then
      begin
        try

          if WTOP then
            if R.ValueExists(preffix + C.GetNamePath + '.TOP' + postfix) then
              T.Top := R.ReadInteger(preffix + C.GetNamePath + '.TOP' +
                postfix);
        except
        end;
        try
          if WEnabled then
            if R.ValueExists(preffix + C.GetNamePath + '.Enabled' + postfix)
              then
              T.Enabled := R.ReadBool(preffix + C.GetNamePath + '.Enabled' +
                postfix);
        except
        end;
        try
          if WVisible then
            if R.ValueExists(preffix + C.GetNamePath + '.TOP' + postfix) then
              T.Visible := R.ReadBool(preffix + C.GetNamePath + '.TOP' +
                postfix);
        except
        end;

        try
          if WLEFT then
            if R.ValueExists(preffix + C.GetNamePath + '.LEFT' + postfix) then
              T.Left := R.ReadInteger(preffix + C.GetNamePath + '.LEFT' +
                postfix);
        except
        end;
        try
          if WTAG then
            if R.ValueExists(preffix + C.GetNamePath + '.TAG' + postfix) then
              T.Tag := R.ReadInteger(preffix + C.GetNamePath + '.TAG' +
                postfix);
        except
        end;
        try
          if WHEIGHT then
            if R.ValueExists(preffix + C.GetNamePath + '.HEIGHT' + postfix) then
              T.Height := R.ReadInteger(preffix + C.GetNamePath + '.HEIGHT' +
                postfix);
        except
        end;
        try
          if WWIDTH then
            if R.ValueExists(preffix + C.GetNamePath + '.WIDTH' + postfix) then
              T.Width := R.ReadInteger(preffix + C.GetNamePath + '.WIDTH' +
                postfix);
        except
        end;
        if WTEXT then
          if R.ValueExists(preffix + C.GetNamePath + '.Text' + postfix) then
          begin
            try
              TUPC(T).Text := R.ReadString(preffix + C.GetNamePath + '.Text' +
                postfix);
            except
              try
                if T is TCustomEdit then
                  TCustomEdit(T).Text := R.ReadString(preffix + C.GetNamePath +
                    '.Text' + postfix);
              except
              end;
            end;
          end;
        if WCOLOR then
          if R.ValueExists(preffix + C.GetNamePath + '.Color' + postfix) then
          begin
            try
              TUPC(T).Color := R.ReadInteger(preffix + C.GetNamePath + '.Color'
                + postfix);
            except
            end;
          end;
        if WCaption then
          if R.ValueExists(preffix + C.GetNamePath + '.Caption' + postfix) then
          begin
            try
              TUPC(T).Caption := R.ReadString(preffix + C.GetNamePath +
                '.Caption' + postfix);
            except
              try
                if T is TButton then
                  TButton(T).Caption := R.ReadString(preffix + C.GetNamePath +
                    '.Caption' + postfix);
                if T is TCustomLabel then
                  TCustomLabel(T).Caption := R.ReadString(preffix + C.GetNamePath
                    + '.caption' + postfix);
                if T is TCheckBox then
                  TCheckBox(T).Caption := R.ReadString(preffix + C.GetNamePath +
                    '.Caption' + postfix);
                if T is TRadioButton then
                  TRadioButton(T).Caption := R.ReadString(preffix + C.GetNamePath
                    + '.Caption' + postfix);
                if T is TGroupBox then
                  TGroupBox(T).Caption := R.ReadString(preffix + C.GetNamePath +
                    '.Caption' + postfix);
                if T is TRadioGroup then
                  TRadioGroup(T).Caption := R.ReadString(preffix + C.GetNamePath
                    + '.Caption' + postfix);
                if T is TPanel then
                  TPanel(T).Caption := R.ReadString(preffix + C.GetNamePath +
                    '.Caption' + postfix);
                if T is TSpeedButton then
                  TSpeedButton(T).Caption := R.ReadString(preffix + C.GetNamePath
                    + '.Caption' + postfix);
                if T is TStaticText then
                  TStaticText(T).Caption := R.ReadString(preffix + C.GetNamePath
                    + '.Caption' + postfix);
              except
              end;

            end;

          end;

      end;
      R.Free;
    end
    else
    begin
      if C is TYesOrNoDialog then
      begin
        R := TRegistry.Create;
        R.RootKey := RegRootHKEY;
        if R.OpenKey(RegPath, False) then
        begin
          if WCaption then
            if R.ValueExists(preffix + C.GetNamePath + '.Caption' + postfix)
              then
              TYesOrNoDialog(C).caption := R.ReadString(preffix + C.GetNamePath +
                '.Caption' + postfix);
          if WText then
            if R.ValueExists(preffix + C.GetNamePath + '.Text' + postfix) then
              TYesOrNoDialog(C).text := R.ReadString(preffix + C.GetNamePath +
                '.Text' + postfix);
        end;
        R.Free;
      end;
      if C is TPopupMenu then
      begin
        R := TRegistry.Create;
        R.RootKey := RegRootHKEY;
        if R.OpenKey(RegPath, True) then
        begin
          for I := 0 to TPopupMenu(C).Items.Count - 1 do
          begin
            if WCaption then
              if R.ValueExists(preffix + C.GetNamePath + '.Item[' + IntToStr(I) +
                '].Caption' + postfix) then
                TPopupMenu(C).Items[I].caption := R.ReadString(preffix +
                  C.GetNamePath + '.Item[' + IntToStr(I) + '].Caption' + postfix);
            if WEnabled then
              if R.ValueExists(preffix + C.GetNamePath + '.Item[' + IntToStr(I) +
                '].Enabled' + postfix) then
                TPopupMenu(C).Items[I].Enabled := R.ReadBool(preffix +
                  C.GetNamePath + '.Item[' + IntToStr(I) + '].Enabled' + postfix);
            if WVisible then
              if R.ValueExists(preffix + C.GetNamePath + '.Item[' + IntToStr(I) +
                '].Visible' + postfix) then
                TPopupMenu(C).Items[I].Visible := R.ReadBool(preffix +
                  C.GetNamePath + '.Item[' + IntToStr(I) + '].Visible' + postfix);
            if WChecked then
              if R.ValueExists(preffix + C.GetNamePath + '.Item[' + IntToStr(I) +
                '].Checked' + postfix) then
                TPopupMenu(C).Items[I].Checked := R.ReadBool(preffix +
                  C.GetNamePath + '.Item[' + IntToStr(I) + '].Checked' + postfix);
          end;
        end;
        R.Free;
      end;

    end;
  end;
  for I := 0 to C.ComponentCount - 1 do
    LoadComponentState(C.Components[i], preffix + C.GetNamePath + '.', postfix);

end;

end.

Статья Сохранение состояния ВСЕХ компонентов раздела Компоненты и Классы Компоненты может быть полезна для разработчиков на delphi & pascal.

Комментарии и вопросы

:: Главная :: Компоненты ::