Сохранение свойств компонента в файл

← →
Vitalik (2004-07-02 10:58) [0]

Привет! Я тут бьюсь над одной задачкой. У меня есть компонент TChart на котором отображаются графики. Для TChart будут предусмотрены настройки - при помощи TChartEditor или TTeeCommander. Настройки нужно сохранять в поток. То есть пользователь сможет сам устанавливать настройки и сохранять их в файл. Вот в этом проблема - настроек у TChart великое множество. И я отказался от того, чтобы вручную каждую опцию записывать в файл, а потом считывать.

Решил я как-то автоматизировть процесс сохранения настроек. Хотя бы и не всех - это как получится.

Для этого я сначала попробовал всякие TWriter и TReader но мне показалось (долго не углублялся) что они, мягко говоря не работают. Не знаю, может я что-то не то делаю, в общем я пошёл другим путём. Для начала я попытался в дереве отобразить все

параметры компонента и написал такую процедуру:

procedure TForm1.FillProps(ANode: TtreeNode; AObject: TObject);
var
ATypeInfo: PTypeInfo;
ATypeData: PTypeData;
i, n, l: integer;
List: PPropList;
NNode: TTreeNode;
s: string;
ObjProp: TObject;

IntVal: integer;
begin
ATypeData := GetTypeData(AObject.ClassInfo);
n := ATypeData.PropCount;

if N <= 0 then
Exit;

GetMem(List, SizeOf(PPropInfo)*N);
try
GetPropInfos(AObject.ClassInfo,List);
for I:= 0 to N - 1 do
begin
if AObject.FieldAddress(List[I]^.name) <> nil then showmessage(List[I]^.name);

case List[I].PropType^.Kind of

tkEnumeration:
begin
ATypeInfo := List[I].PropType^;

IntVal := GetEnumValue(ATypeInfo,List[i]^.name);
NNode := tv.Items.AddChild(ANode, List[I]^.name + ": "+ List[I]^.PropType^.Name +" = " + IntToStr(intVal));
end;
tkInteger:
begin
IntVal := Integer(GetPropValue(AObject, List[i]^.name));
NNode := tv.Items.AddChild(ANode, List[I]^.name + ": Integer = " + IntToStr(IntVal) );
end;

tkFloat:
begin
NNode := tv.Items.AddChild(ANode, List[I]^.name + ": " + List[I]^.PropType^.Name + " = " +

FloatToStr(GetFloatProp(AObject, List[i]^.Name)) );
end;
tkString, tkLString, tkWString:
begin
NNode := tv.Items.AddChild(ANode, List[I]^.name + ": String = " + GetStrProp(AObject, List[i]^.name));

end;
tkSet:
begin

s := GetSetProp(AObject, List[i]^.name, false);
Intval := GetOrdProp(AObject, List[i]^.name);
NNode := tv.Items.AddChild(ANode, List[I]^.name + ": Set of" + List[i]^.PropType^.name +" = " + s + " (" +

IntToStr(IntVal) + ")");

end;
tkClass:
begin
NNode := tv.Items.AddChild(ANode, List[I]^.name + ": " + List[I]^.PropType^.Name);
try
ObjProp := nil;
ObjProp := GetObjectProp(AObject, List[I]^.name);
if ( ObjProp <> nil) then
FillProps(
NNode,
ObjProp
);
except

end;
end;
end;

end;
finally
FreeMem(List,SizeOf(PPropInfo)*N);
end;
end;

Она хоть и выводит ошибку при входе в один из классов, но в целом работает. Кстати, с Enumeration и Set у меня есть отдельные вопросы, но сейчас не об этом.

Потом, немного преобразовав эту процедуру я получил две другие - для чтения и записи настроек в поток/из потока:

procedure TForm1.SaveObjectToStream(AStream: TStream; AObject: TObject);
var
ATypeInfo: PTypeInfo;
ATypeData: PTypeData;
i, n, l: integer;
List: PPropList;

s: string;
StrLen: String;
ObjProp: TObject;

IntVal: integer;
FloatVal: real;
begin
ATypeData := GetTypeData(AObject.ClassInfo);
n := ATypeData.PropCount;

if N <= 0 then
Exit;

GetMem(List, SizeOf(PPropInfo)*N);
try
GetPropInfos(AObject.ClassInfo,List);
for I:= 0 to N - 1 do
begin
case List[I].PropType^.Kind of

tkEnumeration:
begin
ATypeInfo := List[I].PropType^;

IntVal := GetEnumValue(ATypeInfo,List[i]^.name);
AStream.Write(IntVal, SizeOF(IntVal) );
end;
tkInteger:
begin
IntVal := Integer(GetPropValue(AObject, List[i]^.name));
AStream.Write(IntVal, SizeOF(IntVal) );
end;

tkFloat:
begin
FloatVal := GetFloatProp(AObject, List[i]^.Name);
AStream.Write(FloatVal, SizeOF(FloatVal) );
end;
tkString, tkLString, tkWString:
begin
s := GetStrProp(AObject, List[i]^.name);
IntVal := Length(S);
AStream.Write(IntVal, SizeOf(IntVal) );
AStream.Write(PChar(s)^, IntVal);
end;
tkSet:
begin
Intval := GetOrdProp(AObject, List[i]^.name);
AStream.Write(IntVal, SizeOf(IntVal) );
end;
tkClass:
begin
try
ObjProp := nil;
ObjProp := GetObjectProp(AObject, List[I]^.name);
if ( ObjProp <> nil) then
SaveObjectToStream(AStream, ObjProp);
except

end;
end;
end;

end;
finally
FreeMem(List,SizeOf(PPropInfo)*N);
end;
end;

Продолжение - в следующем сообщении, потому что в одно всё не помещается :)

← →
Vitalik (2004-07-02 10:58) [1]

Продолжение.

procedure TForm1.LoadObjectFromStream(AStream: TStream; AObject: TObject);
var
ATypeInfo: PTypeInfo;
ATypeData: PTypeData;
i, n, l: integer;
List: PPropList;

s: string;
StrLen: String;
ObjProp: TObject;

IntVal: integer;
FloatVal: real;
begin
ATypeData := GetTypeData(AObject.ClassInfo);
n := ATypeData.PropCount;

if N <= 0 then
Exit;

GetMem(List, SizeOf(PPropInfo)*N);
try
GetPropInfos(AObject.ClassInfo,List);
for I:= 0 to N - 1 do
begin
if AObject.FieldAddress(List[I]^.name) <> nil then showmessage(List[I]^.name);

case List[I].PropType^.Kind of

tkEnumeration:
begin
{ AStream.Read(IntVal, SizeOf(IntVal) );
SetEnumProp(AObject, List[i]^.Name, IntVal);}
end;
tkInteger:
begin
AStream.Read(IntVal, SizeOf(IntVal) );
SetInt64Prop(AObject, List[i]^.Name, IntVal);

end;

tkFloat:
begin
AStream.Read(FloatVal, SizeOf(FloatVal) );
SetFloatProp(AObject, List[i]^.Name, FloatVal);
end;
tkString, tkLString, tkWString:
begin
AStream.Read(IntVal, SizeOf(IntVal) );
SetLength(s, IntVal);
AStream.Read(PChar(s)^, IntVal);
SetStrProp(AObject, List[I]^.name, s);
end;
tkSet:
begin
{ AStream.Read(IntVal, SizeOf(IntVal) );
SetSetProp(AObject, List[I]^.name, );}
end;
tkClass:
begin
try
ObjProp := nil;
ObjProp := GetObjectProp(AObject, List[I]^.name);
if ( ObjProp <> nil) then
LoadObjectFromStream(AStream, ObjProp);
except

end;
end;
end;

end;
finally
FreeMem(List,SizeOf(PPropInfo)*N);
end;
end;

Сохраняется в общем-то без проблем (хотя выдаёт ошибку при заходе в тот же класс). При загрузке происходит такая последовательность:
1. Загружается свойство Tag и нормально устанавливается.
2. Загружается свойство name - тоже всё нормально.
3. Загружается свойство Left а вот при установке свойства происходит ошибка. И проблема не в считывании данных из потока, а именно при установке занчения, т.е. в SetInt64Prop(AObject, List[i]^.Name, IntVal);

Так вот что у меня не правильно?

И вообще, что вы думаете о моём огороде? :)
Может действительно можно чем-то стандартным обойтись? Или мой подправить? Лучше - править мой, так пользы больше :)

Спасибо!

← →
Анонимщик © (2004-07-02 11:37) [2]

Кажется, лучше стандартным все же. Есть, например, ExtLib

← →
Vitalik (2004-07-02 12:08) [3]

Ну вообще-то мне нужно именно сохранять в файл, а не отображать свойства на экране. Но я попробую разобраться в коде ExtLib Где-то там наверняка должен же быть поиск свойств!

← →
NeyroSpace © (2004-07-02 12:37) [4]

unit Unit1;

interface

uses
Windows, Messages, Classes, Forms;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Form2: TForm;
srtlist: TStringList;

implementation
{$R *.DFM}

function ComponentToString(Component: TComponent): string;
var
ms: TMemoryStream;
ss: TStringStream;
begin
ss := TStringStream.Create(" ");
ms := TMemoryStream.Create;
try
ms.WriteComponent(Component);
ms.position := 0;
ObjectBinaryToText(ms, ss);
ss.position := 0;
Result := ss.DataString;
finally
ms.Free;
ss.free;
end;
end;

procedure StringToComponent(Component: TComponent; Value: string);
var
StrStream:TStringStream;
ms: TMemoryStream;
begin
StrStream := TStringStream.Create(Value);
try
ms := TMemoryStream.Create;
try
ObjectTextToBinary(StrStream, ms);
ms.position := 0;
ms.ReadComponent(Component);
finally
ms.Free;
end;
finally
StrStream.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Form2 := TForm.Create(nil);
srtlist := TStringList.Create;
srtlist.LoadFromFile("Form2.txt");

StringToComponent(Form2, srtlist.Text);

Form2.parent := nil;
Form2.Visible := true;
Form2.Caption := "Создана из Form2.DFM";

srtlist.Free;
end;

end.

==============
файл:
object Form2: TForm
Left = 195
Top = 107
Width = 443
Height = 218
Caption = "Form1"
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
end
==============

Также можно и сохранить

← →
TUser © (2004-07-02 12:45) [5]

Можно еще использовать TJvFormStorage.

← →
Семен Сорокин © (2004-07-02 12:49) [6]

и в RX тоже есть

← →
Romkin © (2004-07-02 12:49) [7]

А нельзя просто использовать TStream.WriteComponent? все published запишется (только не забыть для чтения вернуть позицию в начало ;) )
Есть еще TWriter, TReader, TFiler - они с dfm работают.

← →
Анонимщик © (2004-07-02 12:53) [8]

Да еще есть и TParser в Classes.pas, с dfm-ами этими поможет работать. А список свойств вытаскивается с помощью функций types.pas. Но со всем вышесказанным его можно и не использовать.

← →
Vitalik (2004-07-02 13:37) [9]

4, 7 приводит примерно к следующему результату:

object Chart1: TChart
Left = 528
Top = 96
Width = 136
Height = 250
Title.Text.Strings = (
"TChart")
TabOrder = 1
end

2NeyroSpace
Ну вот видите, только эти свойства. А ведь на форме наверняка были и кнопки! Где кнопки-то в полученном файле?

Я не проверял, но думаю, что если добавить в мои процедуры обработку также и массивов tkArray - то тогда будет в дереве отображаться и свойства Controls и Components.

Так что это как бы не то, что мне нужно... Попробуйте запустить процедуру FillProps и станет ясно, что мне нужно пробегаться по большему количеству свойств!

2TUser
TJvFormStorage - а что это и где можно взять?

← →
Vitalik (2004-07-02 15:02) [10]

А кто-нибудь значет, почему вообще не работает

SetInt64Prop(button1, "left", 100);

?

И как сделать чтоб работало?

> TJvFormStorage

В FreeWare библиотеке JVCL http://jvcl.sourceforge.net/

Сохранение свойств компонента в файл Найти похожие ветки