Saving Listbox Data to XML?

问题:

I have 2 listboxes, the first listbox stores data pointers for each items Object property (defined by a custom class I have written). Whenever I select an item from this listbox, I populate the second listbox by accessing some of the data stored on the first listbox.

That is all good, but now I need to know how to save and restore the listboxes to XML.

I would appreciate it if someone could provide an example or assist me in writing the code to do this.

Here is some sample code to show how I create and access the data:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    cmdAdd: TButton;
    txtValue1: TEdit;
    txtValue2: TEdit;
    procedure cmdAddClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TMyData = class(TObject)
  private
    FValue1: String;
    FValue2: String;
  public
    constructor Create(Value1, Value2: String);

    property Value1: String read FValue1 write FValue1;
    property Value2: String read FValue2 write FValue2;
end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyData }

constructor TMyData.Create(Value1, Value2: String);
begin
  inherited Create;

  FValue1:= Value1;
  FValue2:= Value2;
end;

procedure TForm1.cmdAddClick(Sender: TObject);
var
  Obj: TMyData;
begin
  Obj:= TMyData.Create(txtValue1.Text, txtValue2.Text);
  Listbox1.AddItem(txtValue1.Text, Obj);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  Obj: TMyData;
begin
  ListBox2.Items.Clear;

  Obj:= ListBox1.Items.Objects[ListBox1.ItemIndex] as TMyData;
  ListBox2.Items.Add(Obj.Value2);
end;

end.

回答1:

tl;dr: Use the XML Data Binding wizard to create interfaces for handling your specific XML file, ét voila.

The most easy way to implement this is to start with the XML file. For example, build it up as follows:

<?xml version="1.0"?>
<masteritems>
    <masteritem>
        <name>Caption1</name>
        <value>123456</value>
        <childitems>
            <childitem>
                <name>Caption1.1</name>
                <value>23452</value>
            </childitem>
            <childitem>
                <name>Caption1.2</name>
                <value>65465</value>
            </childitem>
        </childitems>
    </masteritem>
    <masteritem>
        ...
    </masteritem>
</masteritems>

Next, create an interface unit for this type of XML file by using the XML Data Binding Wizard, see File > New > Other > New > XML Data Binding. Tweak as you like, but simply passing every wizard page by clicking OK works just fine by default. (Note that the default settings for other Delphi versions might differ from that of mine.) Though the one thing I personally like to get rid of is the "Type" suffix for every interface type. (As well as for the class type names, but that's not an option in the wizard, so you might do that manually.)

And now, to load and manipulate this XML file:

uses
  Classes, Controls, Forms, StdCtrls,
  Test, xmldom, XMLIntf, msxmldom, XMLDoc;

type
  TForm2 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    XMLDocument1: TXMLDocument; { See tab 'Internet' on component palette }
    SaveButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure SaveButtonClick(Sender: TObject);
  private
    function CurrentMasterItem: IXMLMasterItem;
  end;

...

function TForm2.CurrentMasterItem: IXMLMasterItem;
var
  MasterItems: IXMLMasterItems;
  I: Integer;
begin
  MasterItems := GetMasterItems(XMLDocument1);
  for I := 0 to MasterItems.Count - 1 do
  begin
    Result := MasterItems.Masteritem[I];
    if Result.Name = ListBox1.Items[ListBox1.ItemIndex] then
      Break;
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
var
  MasterItems: IXMLMasterItems;
  I: Integer;
begin
  XMLDocument1.FileName := 'Test.xml';
  XMLDocument1.NodeIndentStr := '<tab>';
  MasterItems := GetMasterItems(XMLDocument1);
  for I := 0 to MasterItems.Count - 1 do
    ListBox1.Items.Add(MasterItems[I].Name);
  XMLDocument1.Active := False;
end;

procedure TForm2.ListBox1Click(Sender: TObject);
var
  ChildItems: IXMLChildItems;
  I: Integer;
begin
  if ListBox1.ItemIndex > -1 then
  begin
    ChildItems := CurrentMasterItem.Childitems;
    ListBox2.Clear;
    for I := 0 to ChildItems.Count - 1 do
      ListBox2.Items.AddObject(ChildItems[I].Name,
        TObject(ChildItems[I].Value));
    XMLDocument1.Active := False;
  end;
end;

procedure TForm2.SaveButtonClick(Sender: TObject);
var
  ChildItems: IXMLChildItems;
  ChildItem: IXMLChildItem;
  I: Integer;
begin
  if ListBox1.ItemIndex > -1 then
  begin
    ListBox2.Items.AddObject('New item', TObject(543223));
    ChildItems := CurrentMasterItem.Childitems;
    ChildItems.Clear;
    for I := 0 to ListBox2.Count - 1 do
    begin
      ChildItem := ChildItems.Add;
      ChildItem.Name := ListBox2.Items[I];
      ChildItem.Value := Integer(ListBox2.Items.Objects[I]);
    end;
    XMLDocument1.SaveToFile(XMLDocument1.FileName);
    XMLDocument1.Active := False;
  end;
end;

Update: This is the unit the wizard created here:

{*********************************************************}
{                                                         }
{                    XML Data Binding                     }
{                                                         }
{         Generated on: 10-11-2011 23:25:30               }
{       Generated from: H:\Delphi\Test\XMLTest\Test.xml   }
{   Settings stored in: H:\Delphi\Test\XMLTest\Test.xdb   }
{                                                         }
{*********************************************************}

unit Test;

interface

uses xmldom, XMLDoc, XMLIntf;

type

{ Forward Decls }

  IXMLMasterItems = interface;
  IXMLMasterItem = interface;
  IXMLChildItems = interface;
  IXMLChildItem = interface;

{ IXMLMasterItems }

  IXMLMasterItems = interface(IXMLNodeCollection)
    ['{ACA35986-053A-40AE-92E8-2044BC5DADC6}']
    { Property Accessors }
    function Get_Masteritem(Index: Integer): IXMLMasterItem;
    { Methods & Properties }
    function Add: IXMLMasterItem;
    function Insert(const Index: Integer): IXMLMasterItem;
    property Masteritem[Index: Integer]: IXMLMasterItem
      read Get_Masteritem; default;
  end;

{ IXMLMasterItem }

  IXMLMasterItem = interface(IXMLNode)
    ['{E6481675-AE5B-4166-A977-CA29EC97B78D}']
    { Property Accessors }
    function Get_Name: WideString;
    function Get_Value: Integer;
    function Get_Childitems: IXMLChildItems;
    procedure Set_Name(Value: WideString);
    procedure Set_Value(Value: Integer);
    { Methods & Properties }
    property Name: WideString read Get_Name write Set_Name;
    property Value: Integer read Get_Value write Set_Value;
    property Childitems: IXMLChildItems read Get_Childitems;
  end;

{ IXMLChildItems }

  IXMLChildItems = interface(IXMLNodeCollection)
    ['{CD16D91C-30E5-45A1-AAA1-1C518C84EA5B}']
    { Property Accessors }
    function Get_Childitem(Index: Integer): IXMLChildItem;
    { Methods & Properties }
    function Add: IXMLChildItem;
    function Insert(const Index: Integer): IXMLChildItem;
    property Childitem[Index: Integer]: IXMLChildItem
      read Get_Childitem; default;
  end;

{ IXMLChildItem }

  IXMLChildItem = interface(IXMLNode)
    ['{F7399037-A33F-4E43-ADF9-000EAD71B418}']
    { Property Accessors }
    function Get_Name: WideString;
    function Get_Value: Integer;
    procedure Set_Name(Value: WideString);
    procedure Set_Value(Value: Integer);
    { Methods & Properties }
    property Name: WideString read Get_Name write Set_Name;
    property Value: Integer read Get_Value write Set_Value;
  end;

{ Forward Decls }

  TXMLMasteritemsType = class;
  TXMLMasteritemType = class;
  TXMLChilditemsType = class;
  TXMLChilditemType = class;

{ TXMLMasteritemsType }

  TXMLMasteritemsType = class(TXMLNodeCollection, IXMLMasterItems)
  protected
    { IXMLMasterItems }
    function Get_Masteritem(Index: Integer): IXMLMasterItem;
    function Add: IXMLMasterItem;
    function Insert(const Index: Integer): IXMLMasterItem;
  public
    procedure AfterConstruction; override;
  end;

{ TXMLMasteritemType }

  TXMLMasteritemType = class(TXMLNode, IXMLMasterItem)
  protected
    { IXMLMasterItem }
    function Get_Name: WideString;
    function Get_Value: Integer;
    function Get_Childitems: IXMLChildItems;
    procedure Set_Name(Value: WideString);
    procedure Set_Value(Value: Integer);
  public
    procedure AfterConstruction; override;
  end;

{ TXMLChilditemsType }

  TXMLChilditemsType = class(TXMLNodeCollection, IXMLChildItems)
  protected
    { IXMLChildItems }
    function Get_Childitem(Index: Integer): IXMLChildItem;
    function Add: IXMLChildItem;
    function Insert(const Index: Integer): IXMLChildItem;
  public
    procedure AfterConstruction; override;
  end;

{ TXMLChilditemType }

  TXMLChilditemType = class(TXMLNode, IXMLChildItem)
  protected
    { IXMLChildItem }
    function Get_Name: WideString;
    function Get_Value: Integer;
    procedure Set_Name(Value: WideString);
    procedure Set_Value(Value: Integer);
  end;

{ Global Functions }

function Getmasteritems(Doc: IXMLDocument): IXMLMasterItems;
function Loadmasteritems(const FileName: WideString): IXMLMasterItems;
function Newmasteritems: IXMLMasterItems;

const
  TargetNamespace = '';

implementation

{ Global Functions }

function Getmasteritems(Doc: IXMLDocument): IXMLMasterItems;
begin
  Result := Doc.GetDocBinding('masteritems',
    TXMLMasteritemsType, TargetNamespace) as IXMLMasterItems;
end;

function Loadmasteritems(const FileName: WideString): IXMLMasterItems;
begin
  Result := LoadXMLDocument(FileName).GetDocBinding('masteritems',
    TXMLMasteritemsType, TargetNamespace) as IXMLMasterItems;
end;

function Newmasteritems: IXMLMasterItems;
begin
  Result := NewXMLDocument.GetDocBinding('masteritems',
    TXMLMasteritemsType, TargetNamespace) as IXMLMasterItems;
end;

{ TXMLMasteritemsType }

procedure TXMLMasteritemsType.AfterConstruction;
begin
  RegisterChildNode('masteritem', TXMLMasteritemType);
  ItemTag := 'masteritem';
  ItemInterface := IXMLMasterItem;
  inherited;
end;

function TXMLMasteritemsType.Get_Masteritem(Index: Integer): IXMLMasterItem;
begin
  Result := List[Index] as IXMLMasterItem;
end;

function TXMLMasteritemsType.Add: IXMLMasterItem;
begin
  Result := AddItem(-1) as IXMLMasterItem;
end;

function TXMLMasteritemsType.Insert(const Index: Integer): IXMLMasterItem;
begin
  Result := AddItem(Index) as IXMLMasterItem;
end;

{ TXMLMasteritemType }

procedure TXMLMasteritemType.AfterConstruction;
begin
  RegisterChildNode('childitems', TXMLChilditemsType);
  inherited;
end;

function TXMLMasteritemType.Get_Name: WideString;
begin
  Result := ChildNodes['name'].Text;
end;

procedure TXMLMasteritemType.Set_Name(Value: WideString);
begin
  ChildNodes['name'].NodeValue := Value;
end;

function TXMLMasteritemType.Get_Value: Integer;
begin
  Result := ChildNodes['value'].NodeValue;
end;

procedure TXMLMasteritemType.Set_Value(Value: Integer);
begin
  ChildNodes['value'].NodeValue := Value;
end;

function TXMLMasteritemType.Get_Childitems: IXMLChildItems;
begin
  Result := ChildNodes['childitems'] as IXMLChildItems;
end;

{ TXMLChilditemsType }

procedure TXMLChilditemsType.AfterConstruction;
begin
  RegisterChildNode('childitem', TXMLChilditemType);
  ItemTag := 'childitem';
  ItemInterface := IXMLChildItem;
  inherited;
end;

function TXMLChilditemsType.Get_Childitem(Index: Integer): IXMLChildItem;
begin
  Result := List[Index] as IXMLChildItem;
end;

function TXMLChilditemsType.Add: IXMLChildItem;
begin
  Result := AddItem(-1) as IXMLChildItem;
end;

function TXMLChilditemsType.Insert(const Index: Integer): IXMLChildItem;
begin
  Result := AddItem(Index) as IXMLChildItem;
end;

{ TXMLChilditemType }

function TXMLChilditemType.Get_Name: WideString;
begin
  Result := ChildNodes['name'].Text;
end;

procedure TXMLChilditemType.Set_Name(Value: WideString);
begin
  ChildNodes['name'].NodeValue := Value;
end;

function TXMLChilditemType.Get_Value: Integer;
begin
  Result := ChildNodes['value'].NodeValue;
end;

procedure TXMLChilditemType.Set_Value(Value: Integer);
begin
  ChildNodes['value'].NodeValue := Value;
end;

end.