Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Компоненты и классы
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 16.04.2010, 08:06
LLInJIuHTuK LLInJIuHTuK вне форума
Прохожий
 
Регистрация: 16.04.2010
Сообщения: 1
Репутация: 10
По умолчанию Передача компонентов

Организовал цикл обхода всех компонентов на форме в procedure TForm1.Button1Click(Sender: TObject). Не получается сделать передачу компонентов из цикла в procedure SerializeInternal. Помогите решить эту проблему.

Код:
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.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Комбинированный вид Комбинированный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 00:35.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025