|
Сохранение состояния ВСЕХ компонентов
Автор: Святослав
{ **** 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.
|
Автор проекта: USU Software
Вы можете выкупить этот проект.