Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Сервис для компонентов



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

 Прислал: Святослав (Saint Petersburg) ( 11 августа 2002 г. )
©  (C) NetBreaker666[AWD]<SP666>@Svjatoslav_Lisin - т.е. я сам
 Описание:
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;

 Ограничения:
Проверено в D6 под WinXP, Win98.

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Сохраняет состояние !!!ВСЕХ!!! компонентов (втч и вложенных, втч 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.


Вернуться к списку функций

Наверх ▲