Chip 2002 September/Chip_2002-09_cd1.bin/zkuste/delphi/kolekce/d56/XMLCOMP.ZIP/test/FMain.pas

Pascal/Delphi Source File | 2002-06-17 | 6KB | 219 lines

unit FMain;

interface

{$I DnXml.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, SHDocVw, ExtCtrls, DnXml, ShellApi, TypInfo,
  ComCtrls, DnTestModel, DnPerson {$IFDEF DNXML_D6}, Variants {$ENDIF};

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Panel2: TPanel;
    Label1: TLabel;
    Image1: TImage;
    cbReadOnlyProps: TCheckBox;
    DnXmlReader1: TDnXmlReader;
    DnXmlWriter1: TDnXmlWriter;
    DnXmlDictionary1: TDnXmlDictionary;
    ListView1: TListView;
    Splitter1: TSplitter;
    Button3: TButton;
    Label2: TLabel;
    Button4: TButton;
    dlgSave: TSaveDialog;
    Button5: TButton;
    DnTestModel1: TDnTestModel;
    Panel3: TPanel;
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    Splitter2: TSplitter;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure cbReadOnlyPropsClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Label2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    procedure UpdateDictionaryList;
    procedure PrintModel(aModel: TObject; aStrings: TStrings; aIndent: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses DnCountry;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if dlgSave.Execute then
  begin
    DnXmlWriter1.TopNodeName := 'DnTestModel1';
    DnXmlWriter1.ToXmlFile(dlgSave.Filename, DnTestModel1);
    UpdateDictionaryList;
    WebBrowser1.Navigate(dlgSave.Filename);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    WebBrowser1.Navigate(OpenDialog1.Filename);
    DnXmlReader1.FromXmlFileAssign(OpenDialog1.Filename, DnTestModel1);
    UpdateDictionaryList;
    Memo1.Clear;
    PrintModel(DnTestModel1, Memo1.Lines, '');
  end;
end;

procedure TForm1.UpdateDictionaryList;
var i: Integer;
    item: TListItem;
begin
  ListView1.Items.Clear;
  for i := 0 to DnXmlDictionary1.Count - 1 do
  begin
    item := ListView1.Items.Add;
    item.Caption := DnXmlDictionary1.Ids[i];
    item.SubItems.Add(DnXmlDictionary1.Objects[i].ClassName);
  end;
end;

procedure TForm1.cbReadOnlyPropsClick(Sender: TObject);
begin
  DnXmlWriter1.StoreReadOnlyProps := cbReadOnlyProps.Checked;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  DnXmlDictionary1.Clear;
  UpdateDictionaryList;
end;

procedure TForm1.Label2Click(Sender: TObject);
begin
  ShellExecute(0, 'open', 'http://sourceforge.net/projects/xmlcomp/', nil, nil, 0);
end;

procedure TForm1.Button4Click(Sender: TObject);
var prevpropkinds: TTypeKinds;
begin
  if dlgSave.Execute then
  begin
    // for forms do not store child objects
    prevpropkinds := DnXmlWriter1.PropKinds;
    DnXmlWriter1.PropKinds := tkProperties - [tkClass];
    try
      DnXmlWriter1.TopNodeName := 'Form1';
      DnXmlWriter1.ToXmlFile(dlgSave.FileName, Self);
      UpdateDictionaryList;
      WebBrowser1.Navigate(dlgSave.FileName);
    finally
      DnXmlWriter1.PropKinds := prevpropkinds;
    end;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var oldval: Boolean;
begin
  if OpenDialog1.Execute then
  begin
    oldval := DnXmlReader1.ExceptOnMissingProps;
    DnXmlReader1.ExceptOnMissingProps := False; // objects were not written
    try
      DnXmlReader1.FromXmlFileAssign(OpenDialog1.Filename, Self);
      UpdateDictionaryList;
      WebBrowser1.Navigate(OpenDialog1.FileName);
    finally
      DnXmlReader1.ExceptOnMissingProps := oldval;
    end;
  end;
end;

procedure TForm1.PrintModel(aModel: TObject; aStrings: TStrings; aIndent: string);
var props: PPropList;
    propcount,i: Integer;
begin
  if (aModel <> nil) and (aModel.ClassInfo <> nil) then
  begin
    propcount := GetTypeData(aModel.ClassInfo).PropCount;
    GetMem(props, propcount * SizeOf(PPropInfo));
    try
      GetPropInfos(aModel.ClassInfo, props);
      for i := 0 to propcount - 1 do
      begin
        aStrings.Add(aIndent + props[i].Name + ' = ' + VarToStr(GetPropValue(aModel, props[i].Name)));
        if props[i].PropType^.Kind = tkClass then
        begin
          PrintModel(TObject(GetOrdProp(aModel, props[i])), aStrings, aIndent + '  ');
        end;
      end;
    finally
      FreeMem(props);
    end;
  end;
  // mimic list storage
  if aModel is TList then
  begin
    with TList(aModel) do
    begin
      for i := 0 to Count - 1 do
      begin
        aStrings.Add(aIndent + '  Item' + IntToStr(i) + ' = ' + IntToStr(Integer(Items[i])));
        PrintModel(Items[i], aStrings, aIndent + '    ');
      end;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
  PrintModel(DnTestModel1, Memo1.Lines, '');
end;

procedure TForm1.Button6Click(Sender: TObject);
var person: TPerson;
    nederland: TCountry;
begin
  nederland := DnTestModel1.AddCountry('Nederland');
  DnTestModel1.AddCountry('Belgie');
  DnTestModel1.AddCountry('France');
  DnTestModel1.AddCountry('Deutschland');
  DnTestModel1.AddCountry('Espagne');

  person := TPerson.Create(DnTestModel1);
  person.Firstname  := 'Dave';
  person.Middlename := 'de';
  person.Lastname   := 'Jong';
  person.Address.Street  := 'Somestreet';
  person.Address.Number  := '42';
  person.Address.Zipcode := '1234 AB';
  person.Address.City    := 'Eindhoven';
  person.Address.Country := nederland;
  DnTestModel1.Persons.Add(person);

  Memo1.Clear;
  PrintModel(DnTestModel1, Memo1.Lines, '');
end;

end.