source: tools/Image resize/UBitmapSet.pas

unit UBitmapSet;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, fgl, XMLRead, XMLWrite, DOM, UXMLUtils;

type

  { TBitmapDesc }

  TBitmapDesc = class
    Name: string;
    Rect: TRect;
    Color1: Cardinal;
    Color2: Cardinal;
  private
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
  end;

  { TBitmapDescs }

  TBitmapDescs = class(TFPGObjectList<TBitmapDesc>)
  private
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveToNode(Node: TDOMNode);
  end;

  { TBitmapSet }

  TBitmapSet = class
    FileName: string;
    ImageFileName: string;
    Items: TBitmapDescs;
    procedure LoadFromFile(FileName: string);
    procedure SaveToFile(FileName: string);
    constructor Create;
    destructor Destroy; override;
  end;


implementation

resourcestring
  SWrongFileFormat = 'Wrong file format';


procedure TBitmapDesc.SaveToNode(Node: TDOMNode);
begin
  WriteString(Node, 'Name', Name);
  WriteInteger(Node, 'Left', Rect.Left);
  WriteInteger(Node, 'Top', Rect.Top);
  WriteInteger(Node, 'Width', Rect.Width);
  WriteInteger(Node, 'Height', Rect.Height);
  WriteInteger(Node, 'Color1', Color1);
  WriteInteger(Node, 'Color2', Color2);
end;

procedure TBitmapDesc.LoadFromNode(Node: TDOMNode);
begin
  Name := ReadString(Node, 'Name', '');
  Rect.Left := ReadInteger(Node, 'Left', 0);
  Rect.Top := ReadInteger(Node, 'Top', 0);
  Rect.Width := ReadInteger(Node, 'Width', 0);
  Rect.Height := ReadInteger(Node, 'Height', 0);
  Color1 := ReadInteger(Node, 'Color1', 0);
  Color2 := ReadInteger(Node, 'Color2', 0);
end;

procedure TBitmapDescs.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  for I := 0 to Count - 1 do
  with TBitmapDesc(Items[I]) do begin
    NewNode2 := Node.OwnerDocument.CreateElement('Bitmap');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

procedure TBitmapDescs.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewItem: TBitmapDesc;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Bitmap') do begin
    NewItem := TBitmapDesc.Create;
    NewItem.LoadFromNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
end;

{ TBitmapSet }

constructor TBitmapSet.Create;
begin
  Items := TBitmapDescs.Create;
end;

destructor TBitmapSet.Destroy;
begin
  FreeAndNil(Items);
  inherited;
end;

procedure TBitmapSet.LoadFromFile(FileName: string);
var
  NewNode: TDOMNode;
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  Self.FileName := FileName;
  ReadXMLFile(Doc, FileName);
  with Doc do try
    if Doc.DocumentElement.NodeName <> 'BitmapSet' then
      raise Exception.Create(SWrongFileFormat);
    RootNode := Doc.DocumentElement;
    with RootNode do begin
      ImageFileName := ReadString(RootNode, 'Image', '');

      NewNode := FindNode('Bitmaps');
      if Assigned(NewNode) then
        Items.LoadFromNode(NewNode);
    end;
  finally
    Doc.Free;
  end;
end;

procedure TBitmapSet.SaveToFile(FileName: string);
var
  NewNode: TDOMNode;
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  Self.FileName := FileName;
  Doc := TXMLDocument.Create;
  with Doc do try
    RootNode := CreateElement('BitmapSet');
    AppendChild(RootNode);
    with RootNode do begin
      WriteString(RootNode, 'Image', ImageFileName);

      NewNode := OwnerDocument.CreateElement('Bitmaps');
      AppendChild(NewNode);
      Items.SaveToNode(NewNode);
    end;
    ForceDirectories(ExtractFileDir(FileName));
    WriteXMLFile(Doc, FileName);
  finally
    Doc.Free;
  end;
end;

end.