unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TypInfo;
type
TForm1 = class(TForm)
Button1: TButton;
NumEdit: TEdit;
CmbX1: TComboBox;
CheckBox1: TCheckBox;
Edit1: TEdit;
Edit2: TEdit;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
Button2: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
OutStream: TStream;
implementation
{$R *.dfm}
const
ORDINAL_TYPES = [tkInteger, tkChar, tkEnumeration, tkSet];
TAB: string = #9;
CR: string = #13#10;
{
{ пишет строку в выходящий поток. Исп-ся при сериализации }
procedure WriteOutStream(Value: string);
begin
OutStream.Write(Pchar(Value)[0], Length(Value));
end;
// Добавляет открывающий тег с заданным именем
procedure addOpenTag(const Value: string);
var Level : integer;
begin
Level:=1;
WriteOutStream(CR + TAB + '<' + Value + '>');
inc(Level);
end;
{ Добавляет закрывающий тег с заданным именем }
procedure addCloseTag(const Value: string; addBreak: boolean = false);
var Level : integer;
begin
Level:=1;
dec(Level);
if addBreak then
WriteOutStream(CR);//+ DupStr(TAB, Level));
WriteOutStream('</' + Value + '>');//? Valueend;
end; // addCloseTag
{ Добавляет значение в результирующую строку }
procedure addValue(const Value: string);
begin
WriteOutStream(Value);
end;
procedure SerializeInternal(Component: TObject; Level: integer = 1);
var
BlockStart, BlockEnd, TagStart, TagEnd: PChar;
TagName, TagValue: PChar;
TypeInf: PTypeInfo;
TypeData: PTypeData;
PropIndex: integer;
AName: string;
PropList: PPropList;
NumProps: word;
i, j : integer;
PropName : string;
PropTypeInf : PTypeInfo;
PropInfo : PPropInfo;
sPropValue: string;
PropObject: TObject;
begin
{ Playing with RTTI }
TypeInf := Component.ClassInfo;
AName := TypeInf^.Name;
TypeData := GetTypeData(TypeInf);
NumProps := TypeData^.PropCount;
GetMem(PropList, NumProps*sizeof(pointer));
try
// Получаем список строк
GetPropInfos(TypeInf, PropList);
for i := 0 to NumProps-1 do
begin
PropName := PropList^[i]^.Name;
PropTypeInf := PropList^[i]^.PropType^;
PropInfo := PropList^[i];
// Хочет ли свойство, чтобы его сохранили ?
//if not IsStoredProp(Component, PropInfo) then continue;
case PropTypeInf^.Kind of
tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet,
tkWChar, tkLString, tkWString, tkVariant:
begin
// Получение значения свойства
sPropValue := GetPropValue(Component, PropName, true);
// Проверяем на пустое значение и значение по умолчанию
if //ExcludeEmptyValues and
(sPropValue = '') then continue;
if //ExcludeDefaultValues and
(PropTypeInf^.Kind in ORDINAL_TYPES)
and (sPropValue = IntToStr(PropInfo.Default)) then continue;
// Перевод в XML
addOpenTag(PropName);
addValue(sPropValue); // Добавляем значение свойства в результат
addCloseTag(PropName);
end;
end; // case
end; // i
finally
FreeMem(PropList, NumProps*sizeof(pointer));
end;
end;
procedure Serialize(Component: TObject; Stream: TStream);
begin
WriteOutStream(PChar(CR + '<' + Component.ClassName + '>'));
SerializeInternal(Component);
WriteOutStream(PChar(CR + '</' + Component.ClassName + '>'));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
f : string;
s : string;
var Stream : TStream;
Path : string;
begin
SaveDialog1.Filter:='Xml files (*.xml)|*.xml';
if SaveDialog1.Execute then begin
(SaveDialog1.FileName + '.xml');
Form1.Caption:=SaveDialog1.FileName;
end;
Path := SaveDialog1.InitialDir + SaveDialog1.FileName +'.xml';
Stream := TFileStream.Create(Path, fmCreate);
OutStream := Stream;
WriteOutStream('<?xml version="1.1" ?>');
WriteOutStream( PChar(CR + '<' + 'Component.ClassName' + '>') );
//Serialize(Form1,Stream);
//Serialize(CmbX1, Stream);
//Serialize(CheckBox1,Stream);
for i := 0 to ComponentCount-1 do
begin
if (Components[i] is tEdit) then
with TEdit(Components[i]) do
begin
Serialize((Components[i] as TEdit),Stream);
//Serialize(((Components[i] as TEdit) as TObject),Stream);
// Serialize((Name as TControl),Stream);
//Serialize(CmbX1, Stream);
end;
end; // for
WriteOutStream( PChar(CR + '</' +'Component.ClassName' + '>'));
end;
procedure TForm1.Button2Click(Sender: TObject);
var OpenDlg : TOpenDialog;
begin OpenDlg := TOpenDialog.Create(Self);
OpenDialog1.Filter:='Xml files (*.xml)|*.xml';
if OpenDlg.Execute then begin
end;
OpenDlg.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Close();
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i, nx : integer;
begin
nx := 10;
for i := 0 to nx - 1 do
CmbX1.AddItem('x'+inttostr(i+1),self);
CmbX1.ItemIndex := 0; // выбор по умолчанию
end;
end.