chlistdataset.pas

双色球矩阵计算程序

unit CHListDataSet;

interface

uses
  Windows, Classes, SysUtils;

type
  TCHListDataSet = class
  private
    FMemStream: TMemoryStream;
    FHasItems: Boolean;
    FEndItems: Boolean;
    FFields: TStringList;
    FIndex: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddField(AField: string; AWidth: Integer);
    procedure AddItem(ACaption: string);
    procedure AddSubItem(ASubItem: string);
    function GetStream: TMemoryStream;
  end;

implementation

{ TCHListDataSet }


constructor TCHListDataSet.Create;
var
  str: string;
begin
  str := '<?xml version="1.0" standalone="yes"?><DATAPACKET Version="2.0"><METADATA><FIELDS>';
  FMemStream := TMemoryStream.Create;
  FMemStream.WriteBuffer(str[1], length(str));
  FHasItems := False;
  FEndItems := False;

  FFields := TStringList.Create;
end;

destructor TCHListDataSet.Destroy;
begin
  FMemStream.Free;
  FFields.Free;
end;

procedure TCHListDataSet.AddField(AField: string; AWidth: Integer);
var
  str: string;
begin
  str := format('<FIELD attrname="%s" fieldtype="string" WIDTH="%d"/>', [AField, AWidth]);
  FMemStream.WriteBuffer(str[1], length(str));
  FFields.Add(AField);
end;

procedure TCHListDataSet.AddItem(ACaption: string);
var
  str: string;
begin
  if not FHasItems then begin
    str := '</FIELDS><PARAMS/></METADATA><ROWDATA>';
    FMemStream.WriteBuffer(str[1], length(str));
    FHasItems := True;
  end;

  FIndex := 0;
  str := '<ROW';
  FMemStream.WriteBuffer(str[1], length(str));
  AddSubItem(ACaption);
end;

procedure TCHListDataSet.AddSubItem(ASubItem: string);
var
  str: string;
begin
  str := format(' %s="%s"', [FFields.Strings[FIndex], ASubItem]);
  FMemStream.WriteBuffer(str[1], length(str));
  FIndex := FIndex + 1;
  if FFields.Count = FIndex then begin
    str := '/>';
    FMemStream.WriteBuffer(str[1], length(str));
  end;
end;

function TCHListDataSet.GetStream: TMemoryStream;
var
  str: string;
begin
  if not FHasItems then begin
    str := '</FIELDS><PARAMS/></METADATA><ROWDATA>';
    FMemStream.WriteBuffer(str[1], length(str));
    FHasItems := True;
  end;
  
  if not FEndItems then Begin
    str := '</ROWDATA></DATAPACKET>';
    FMemStream.WriteBuffer(str[1], length(str));
    FEndItems := true;
  end;

  FMemStream.Position := 0;
  Result := FMemStream;
end;


end.