mainfrm.pas

BMP存入xml文件中,同时也可以读出。包含两个实例

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, xmldom, XMLIntf, msxmldom, XMLDoc,
  EncdDecd;

type
  TNodeData = class
    FPath: string;
  public
    property Path: string read FPath write FPath;
    constructor Create(const APath: string = '');
  end;

type
  TFrmMain = class(TForm)
    lsbFile: TListBox;
    btnOpenBMP: TButton;
    dlgOpen: TOpenDialog;
    dlgSave: TSaveDialog;
    btnSaveToXML: TButton;
    imgToWrite: TImage;
    btnOpenXML: TButton;
    tvXML: TTreeView;
    imgRead: TImage;
    bvlToWrite: TBevel;
    bvlRead: TBevel;
    procedure btnOpenBMPClick(Sender: TObject);
    procedure btnSaveToXMLClick(Sender: TObject);
    procedure btnOpenXMLClick(Sender: TObject);
    procedure tvXMLChange(Sender: TObject; Node: TTreeNode);
    procedure FormDestroy(Sender: TObject);
  private
    procedure LoadTreeFromXML(const FileName: string);
    procedure SaveToXML(const FileName: string);
  end;

var
  FrmMain: TFrmMain;

{ 69 64 73 6F 6C }  

implementation

{$R *.dfm}

{ TNodeData }

constructor TNodeData.Create(const APath: string);
begin
  FPath := APath;
end;

{ TFrmMain }

procedure TFrmMain.btnOpenBMPClick(Sender: TObject);
begin
  dlgOpen.DefaultExt := 'bmp';
  dlgOpen.Filter := 'Bitmap File|*.bmp';
  if dlgOpen.Execute then
  begin
    lsbFile.Items.Add(dlgOpen.FileName);
    imgToWrite.Picture.Bitmap.LoadFromFile(dlgOpen.FileName);
  end;
end;

procedure TFrmMain.btnSaveToXMLClick(Sender: TObject);
begin
  dlgSave.DefaultExt := 'xml';
  dlgSave.Filter := 'XML File|*.xml';
  if dlgSave.Execute then
  begin
    SaveToXML(dlgSave.FileName);
    LoadTreeFromXML(dlgSave.FileName);
  end;
end;

procedure TFrmMain.btnOpenXMLClick(Sender: TObject);
begin
  dlgOpen.DefaultExt := 'xml';
  dlgOpen.Filter := 'XML File|*.xml';
  if dlgOpen.Execute then
    LoadTreeFromXML(dlgOpen.FileName);
end;

procedure TFrmMain.LoadTreeFromXML(const FileName: string);
var
  xdLoad: TXMLDocument;
  xnRoot: IXMLNode;
  tnRoot: TTreeNode;
  i: Integer;
begin
  tvXML.Items.Clear;

  xdLoad := TXMLDocument.Create(Self);
  try
    Screen.Cursor := crHourGlass;
    btnOpenXML.Enabled := False;

    { load xml doc }
    xdLoad.FileName := FileName;
    xdLoad.DOMVendor := GetDOMVendor('MSXML');
    xdLoad.LoadFromFile(FileName);

    { prepare treeview }
    xnRoot := xdLoad.DocumentElement;
    tnRoot := tvXML.Items.AddObject(nil, xnRoot.NodeName, TNodeData.Create(FileName));
    for i := 0 to Pred(xnRoot.ChildNodes.Count) do
      tvXML.Items.AddChild(tnRoot, xnRoot.ChildNodes[i].NodeName);
    tnRoot.Expanded := True;
    xnRoot := nil;
  finally
    FreeAndNil(xdLoad);
    Screen.Cursor := crDefault;
    btnOpenXML.Enabled := True;
  end;
end;

procedure TFrmMain.SaveToXML(const FileName: string);
var
  msFile: TMemoryStream;
  ssFile, ssOri, ssEnc: TStringStream;
  xdWrite: TXMLDocument;
  xnRoot, xnChild: IXMLNode;
  //xnPathAttr: IXMLNode;
  i: Integer;
begin
  { create a xml doc to write to }
  xdWrite := TXMLDocument.Create(Self);
  try
    Screen.Cursor := crHourGlass;
    btnSaveToXML.Enabled := False;

    xdWrite.DOMVendor := GetDOMVendor('MSXML');
    xdWrite.Active := True;
    xdWrite.Encoding := 'UTF-8';
    xdWrite.Version := '1.0';
    xdWrite.StandAlone := 'yes';
    xdWrite.DocumentElement := xdWrite.CreateNode('Information');

    xnRoot := xdWrite.DocumentElement;

    { needless, cos' we never retrieve it.
      reserved for later use on attribute node creation. }
    //xnPathAttr := xdWrite.CreateNode('Path', ntAttribute);
    //xnPathAttr.NodeValue := FileName;
    //xnRoot.AttributeNodes.Add(xnPathAttr);

    msFile := TMemoryStream.Create;
    try
      ssFile := TStringStream.Create('');
      try
        ssEnc := TStringStream.Create('');
        try
          for i := 0 to Pred(lsbFile.Items.Count) do
          begin
            xnChild := xdWrite.CreateNode('Image' + IntToStr(i+1));
            xnRoot.ChildNodes.Add(xnChild);

            msFile.LoadFromFile(lsbFile.Items.Strings[i]);
            ssFile.Position := 0;
            msFile.SaveToStream(ssFile);
            ssOri := TStringStream.Create(ssFile.DataString);
            try
              ssEnc.Position := 0;
              EncodeStream(ssOri, ssEnc);
              xnChild.Text := ssEnc.DataString;
            finally
              FreeAndNil(ssOri);
            end;
          end;
        finally
          FreeAndNil(ssEnc);
        end;
      finally
        FreeAndNil(ssFile);
      end;
    finally
      FreeAndNil(msFile);
    end;
    xdWrite.SaveToFile(FileName);
  finally
    FreeAndNil(xdWrite);
    Screen.Cursor := crDefault;
    btnSaveToXML.Enabled := True;
  end;
end;

procedure TFrmMain.tvXMLChange(Sender: TObject; Node: TTreeNode);
var
  ssOri, ssDec: TStringStream;
  xdLoad: TXMLDocument;
  xnRoot: IXMLNode;
  s: string;
begin
  { load xml document }
  xdLoad := TXMLDocument.Create(Self);
  try
    if (tvXML.Items.Count > 0) and Assigned(tvXML.Items[0].Data) then
    begin
      xdLoad.FileName := TNodeData(tvXML.Items[0].Data).Path; { todo: proper filename }
      xdLoad.DOMVendor := GetDOMVendor('MSXML');
      xdLoad.LoadFromFile(xdLoad.FileName);

      { locate node and decode content }
      xnRoot := xdLoad.DocumentElement;
      s := xnRoot.ChildNodes.Nodes[Node.Text].Text;
      ssOri := TStringStream.Create(s);
      try
        ssDec := TStringStream.Create('');
        try
          DecodeStream(ssOri, ssDec);
          ssDec.Position := 0;
          imgRead.Picture.Bitmap.LoadFromStream(ssDec);
        finally
          FreeAndNil(ssDec);
        end;
      finally
        FreeAndNil(ssOri);
      end;
    end;
  finally
    FreeAndNil(xdLoad);
  end;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  if (tvXML.Items.Count > 0) and Assigned(tvXML.Items[0].Data) then
  begin
    TNodeData(tvXML.Items[0].Data).Free;
    tvXML.Items[0].Data := nil;
  end;
end;

end.