... save (object) configuration data easily?
Author: Sven Lorenz
unit Unit_UserConfig;
//////////////////////////////////////////////////////////////////////
///
/// Unit zur vereinfachten Speicherung von User-Daten
///
/// Mittels Save werden die Eigenschaften ALLER Child-Komponenten einer
/// Komponente gespeichert.
/// Load holt diese dann wieder
///
/// In Datei speichern
/// UserConfig:=TUserConfig.Create(0); //Nur auf Festplatte speichern
/// aufruf z.B. SaveToFile (GroupBox1,'configuratio.cfg');
/// LoadFromFile(GroupBox1,'configuratio.cfg');
///
/// In Speicher ablegen
/// (Damit kann z.B eine Undo-Funktion für Optionen realisiert werden)
/// UserConfig:=TUserConfig.Create(10); //Plätze zur Speicherung bereithalten
/// aufruf z.B. SaveToFile (Form1,5); //Auf Platz 5 speichern
/// LoadFromFile(Form1,5); //von Platz 4 laden
///
///
///(c) 2005 Borg@Sven-of-Nine.de
///
///Beispielprogramm unter www.Sven-of-Nine.de
///
//////////////////////////////////////////////////////////////////////
interface
uses Classes;
type
TUserConfig = class(TObject)
private
{ Private-Deklarationen }
//Direkter Zugriff auf Eigenschaften
//set properties using winapi
function IsProperty(Obj: TObject; sProp: string): Boolean;
function SetProperty(Obj: TObject; sProp: string; vValue: Variant): Boolean;
function HasAncestor(Child: TComponent; Name: string): Boolean;
public
{ Public-Deklarationen }
constructor Create(MaxMemory: Integer = 10);
destructor Destroy(); override;
//Komponenten in Datei schreiben
//save/load components to/from file
function SaveToFile(Component: TComponent; sFilename: string): Boolean;
function LoadFromFile(Component: TComponent; sFilename: string): Boolean;
//Komponenten in Speicher schreiben (UNDO-Funktion)
//save/load components to/from mem
function SaveToMemory(Component: TComponent; Index: Integer): Boolean;
function LoadFromMemory(Component: TComponent; Index: Integer): Boolean;
end;
implementation
uses Windows, SysUtils, Controls, Forms, TypInfo;
var
aMemStream: array of TMemoryStream;
//////////////////////////////////////////////////////////////////////
/// Konstruktor und Destruktor
//////////////////////////////////////////////////////////////////////
constructor TUserConfig.Create(MaxMemory: Integer = 10);
var
iIndex: Integer;
begin
//Alle angeforderten Speicherstreams initialisieren
//initialize memorystreams
if (MaxMemory > 255) then MaxMemory := 255;
try
SetLength(aMemStream, MaxMemory);
for iIndex := 0 to MaxMemory - 1 do
begin
aMemStream[iIndex] := TMemoryStream.Create;
end;
finally
end;
end;
destructor TUserConfig.Destroy();
var
iIndex: Integer;
begin
//Alle angeforderten Speicherstreams freimachen
//free all
for iIndex := 0 to Length(aMemStream) - 1 do
begin
aMemStream[iIndex].Free;
end;
SetLength(aMemStream, 0);
end;
//////////////////////////////////////////////////////////////////////
/// Prüfen, ob ein Object die gewünschte Eigenschaft hat
/// Check for properties
//////////////////////////////////////////////////////////////////////
function TUserConfig.IsProperty(Obj: TObject; sProp: string): Boolean;
var
plList: tPropList;
iIndex1: Integer;
iIndex2: Integer;
begin
Result := False;
//Alle verfügbaren Properties holen
//get properties
iIndex2 := GetPropList(PTypeInfo(Obj.ClassInfo),
[tkUnknown, tkVariant, tkInteger, tkInt64, tkFloat,
tkString, tkWString, tkLString, tkChar, tkWChar,
tkEnumeration, tkSet, tkClass, tkMethod, tkArray,
tkDynArray, tkRecord, tkInterface], @plList);
//nach der gewünschten suchen
//search for the wanted
iIndex1 := 0;
while (iIndex1 < iIndex2) do
begin
if plList[iIndex1].Name = sProp then
begin
Result := True;
iIndex1 := iIndex2;
end;
Inc(iIndex1);
end;
end;
//////////////////////////////////////////////////////////////////////
/// Eine Egenschaft direkt setzen
/// set properties
//////////////////////////////////////////////////////////////////////
function TUserConfig.SetProperty(Obj: TObject; sProp: string; vValue: Variant): Boolean;
begin
if (IsProperty(Obj, sProp)) then
begin
SetPropValue(Obj, sProp, vValue);
Result := True;
end
else
begin
Result := False;
end;
end;
//////////////////////////////////////////////////////////////////////
/// Nach einem Vorfahr mit dem Namen "Name" suchen
/// check for ancestor named "Name"
//////////////////////////////////////////////////////////////////////
function TUserConfig.HasAncestor(Child: TComponent; Name: string): Boolean;
var
cWork: TComponent;
begin
Result := False;
cWork := Child;
while (cWork.HasParent) do
begin
//Eltern holen
cWork := cWork.GetParentComponent;
//Sind die Eltern die gesuchten ?
if (cWork.Name = Name) then
begin
//Dann Suche beenden
Result := True;
break;
end;
end;
cWork := nil;
end;
//////////////////////////////////////////////////////////////////////
/// Save all components to disk
/// alle komponenten in datei speichern
//////////////////////////////////////////////////////////////////////
function TUserConfig.SaveToFile(Component: TComponent; sFilename: string): Boolean;
var
hFile: THandle;
Stream: THandleStream;
iIndex: Integer;
sName: string[255];
cWork: TComponent;
begin
Result := False;
//Datei auf jeden Fall immer neu erzeugen
//Create File
hFile := FileCreate(sFilename);
if (hFile > 0) then
begin
//Die Hauptkomponente finden (das Formular)
//Find parent
cWork := Component;
while (cWork.HasParent) do
begin
cWork := cWork.GetParentComponent;
end;
//Stream erzeugen
//Create stream
Stream := THandleStream.Create(hFile);
try
//Und los
//enumerate all
for iIndex := 0 to cWork.ComponentCount - 1 do
begin
//Ist es ein Win-Control und eine Nachfahre der gewünschten Componente?
//save only TWinControls and childs of Component
if (cWork.Components[iIndex] is TWinControl) and
(HasAncestor(cWork.Components[iIndex], Component.Name)) then
begin
//Hier ein paar Ausnahmen
//some exceptions
if (cWork.Components[iIndex].ClassName <> 'TFlatTitlebar')
and
(cWork.Components[iIndex].ClassName <>
'TFlatSpinEd1itInteger') then
begin
//Erst den Namen
//save name first
sName := cWork.Components[iIndex].Name;
Stream.Write(sName, Length(sName) + 1);
//Und dann die Komponente hinterher
//and component
Stream.WriteComponent(cWork.Components[iIndex]);
end;
end;
end;
Result := True;
finally
//Fertig
//done
Stream.Free;
end;
//close handle
FileClose(hFile);
end;
cWork := nil;
end;
//////////////////////////////////////////////////////////////////////
/// load all components from disk
/// alle komponenten aus datei laden
//////////////////////////////////////////////////////////////////////
function TUserConfig.LoadFromFile(Component: TComponent; sFilename: string): Boolean;
var
hFile: THandle;
Stream: THandleStream;
iIndex: Integer;
sName: string[255];
iName: Integer;
cWork: TComponent;
begin
Result := False;
//Date öffnen
//open read
hFile := FileOpen(sFilename, fmOPENREAD);
if (hFile > 0) then
begin
//Das die Hauptkomponente finden (das Formular)
cWork := Component;
while (cWork.HasParent) do
begin
cWork := cWork.GetParentComponent;
end;
//Stream erzeugen
//create stream
Stream := THandleStream.Create(hFile);
try
//Vorne anfangen
//from the beginning
Stream.Position := 0;
//Und kpl. durchwurstem
//the whole file
while (Stream.Position < Stream.Size) do
begin
//erstes byte des namens
//first byte of Name
Stream.read(sName[0], 1);
//Größe rausholen
//get size
iName := Byte(sName[0]);
//Und den ganzen Namen lesen
//Read the whole name
Stream.read(sName[1], iName);
//Object holen
//get object
try
//Nach dem namen suchens
//search for the name
for iIndex := 0 to cWork.ComponentCount - 1 do
begin
if (cWork.Components[iIndex].Name = sName) then
begin
//Bei allem, was Checked hat, dies erst auf FALSE
// setzen
//Uncheck all "checkables"
SetProperty(cWork.Components[iIndex],
'Checked', False);
//Und dann erst laden
//load
Stream.ReadComponent(cWork.Components[iIndex]);
end;
end;
except
end;
end;
finally
//done
Stream.Free;
end;
FileClose(hFile);
end;
cWork := nil;
end;
//////////////////////////////////////////////////////////////////////
/// Save all components to memory
/// alle komponenten in speicher schreiben
//////////////////////////////////////////////////////////////////////
function TUserConfig.SaveToMemory(Component: TComponent; Index: Integer): Boolean;
var
iIndex: Integer;
sName: string[255];
cWork: TComponent;
begin
Result := False;
if (Index < 0) or (Index >= Length(aMemStream)) then Exit;
try
//Die Hauptkomponente finden (das Formular)
cWork := Component;
while (cWork.HasParent) do
begin
cWork := cWork.GetParentComponent;
end;
for iIndex := 0 to cWork.ComponentCount - 1 do
begin
if (cWork.Components[iIndex] is TWinControl) and
(HasAncestor(cWork.Components[iIndex], Component.Name)) then
begin
if (cWork.Components[iIndex].ClassName <> 'TFlatTitlebar') and
(cWork.Components[iIndex].ClassName <> 'TFlatSpinEd1itInteger') then
begin
sName := Component.Components[iIndex].Name;
aMemStream[Index].Write(sName, Length(sName) + 1);
aMemStream[Index].WriteComponent(cWork.Components[iIndex]);
end;
end;
end;
Result := True;
finally
cWork := nil;
end;
end;
//////////////////////////////////////////////////////////////////////
/// load components[index] from memory
/// komponenten[index] aus speicher lesen
//////////////////////////////////////////////////////////////////////
function TUserConfig.LoadFromMemory(Component: TComponent; Index: Integer): Boolean;
var
iIndex: Integer;
sName: string[255];
iName: Integer;
cWork: TComponent;
begin
Result := False;
if (Index < 0) or (Index >= Length(aMemStream)) then Exit;
try
cWork := Component;
while (cWork.HasParent) do
begin
cWork := cWork.GetParentComponent;
end;
aMemStream[Index].Position := 0;
while (aMemStream[Index].Position < aMemStream[Index].Size) do
begin
aMemStream[Index].read(sName[0], 1);
iName := Byte(sName[0]);
aMemStream[Index].read(sName[1], iName);
try
for iIndex := 0 to cWork.ComponentCount - 1 do
begin
if (cWork.Components[iIndex].Name = sName) then
begin
SetProperty(cWork.Components[iIndex],
'Checked', False);
aMemStream[Index].ReadComponent
(cWork.Components[iIndex]);
end;
end;
except
end;
end;
Result := True;
finally
cWork := nil;
end;
end;
end.
printed from
www.swissdelphicenter.ch
developers knowledge base