Dataset Export

unit DataSetExport;

interface

uses
  Windows, Classes, DBTables, DB, Sysutils, Graphics, Forms;

type
  TAtributCell = (acHidden, acLocked, acShaded, acBottomBorder, acTopBorder, acRightBorder, acLeftBorder, acLeft, acCenter, acRight, acFill);
  TSetOfAtribut = set of TAtributCell;

  TjbFiler = class
  public
    Stream: TStream;
  end;

  TjbWriter = class(TjbFiler)
  public
    procedure WriteSingleStr(const S: string);
    procedure WriteStr(const S: string); {req: s shouldn't exceed 64KB}
    procedure WriteByte(B: Byte);
    procedure WriteDouble(D: Double);
    procedure WriteInt(I: Integer);
    procedure WriteWord(W: Word);
  end;

  TjbPersistent = class
  public
    opCode: Word; //Important: OpCode<>nil, OpcCode<>OpcodeEOF
    procedure Write(W: TjbWriter); virtual; abstract;
  end;

  TDispatcher = class
  private
    StrList: TStringList;
    Writer: TjbWriter;
  protected
    FStream: TStream;
    procedure SetStream(vStream: TStream);
  public
    SLError: TStringList;
    OpcodeEOF: Word;
    procedure Clear;
    procedure RegisterObj(jbPers: TjbPersistent);
    procedure Write;
    constructor Create;
    destructor Destroy; override;
    property Stream: TStream read FStream write SetStream;
  end;

  TData = class(TjbPersistent)
  end;

  TBOF = class(TData)
    procedure Write(aWriter: TjbWriter); override;
    constructor Create;
  end;

  TDimension = class(TData)
    MinSaveRecs,
      MaxSaveRecs,
      MinSaveCols,
      MaxSaveCols: Word;
    procedure Write(aWriter: TjbWriter); override;
    constructor Create;
  end;

  TCellClass = class of TCell;

  TCell = class(TData)
  protected
    FAtribut: array[0..2] of Byte;
    procedure SetAtribut(Value: TSetOfAtribut);
  public
    Col, Row: Word;
    procedure Write(aWrite: TjbWriter); override;
    property Atribut: TSetOfAtribut write SetAtribut;
    constructor Create; virtual; abstract;
  end;

  TBlankCell = class(TCell)
    procedure Write(aWriter: TjbWriter); override;
    constructor Create; override;
  end;

  TDoubleCell = class(TCell)
    Value: Double;
    procedure Write(aWriter: TjbWriter); override;
    constructor Create; override;
  end;

  TWordCell = class(TCell)
    Value: Word;
    procedure Write(aWriter: TjbWriter); override;
    constructor Create; override;
  end;

  TStrCell = class(TCell)
    Value: string;
    procedure Write(aWriter: TjbWriter); override;
    constructor Create; override;
  end;

  TjbExportWrapper = class(TDataSet);
  TjbExport = class
  private
    FFileName: string;
    FTable: TjbExportWrapper;
    procedure SetTable(const Value: TjbExportWrapper);
  protected
    TotalCount: Integer;
    Stream: TStream;

    function GetStringValue(const aField: TField): string;

    procedure DoBeginWriting; virtual;
    procedure DoEndWriting; virtual;
    procedure DoWriteHeader; virtual;
    procedure DoWriteFooter; virtual;
    procedure DoWriteRecord; virtual;
    procedure SaveToStream; virtual;
  public
    constructor Create;
    procedure Execute; virtual;
    property FileName: string read FFileName write FFileName;
    property Table: TjbExportWrapper read FTable write SetTable;
  end;

  TjbExportText = class(TjbExport)
  private
    FSeparator: string;
    FBeginString, FEndString: string;
    procedure WriteLn(const S: string);
  protected
    procedure DoWriteHeader; override;
    procedure DoWriteRecord; override;
  public
    constructor Create;
    property Separator: string read FSeparator write FSeparator;
    property BeginString: string read FBeginString write FBeginString;
    property EndString: string read FEndString write FEndString;
  end;

  TjbExportHTML = class(TjbExport)
  private
    FHeaderFont: TFont;
    FBodyFont: Tfont;
    FShowGrid: Boolean;
    FHeaderBGColor: TColor;
    FBodyBGColor: TColor;
    procedure WriteLn(S: string);
    procedure SetHeaderFont(const Value: TFont);
    procedure SetBodyFont(const Value: Tfont);
    procedure SetShowGrid(const Value: Boolean);
    procedure SetHeaderBGColor(const Value: TColor);
    procedure SetBodyBGColor(const Value: TColor);
  protected
    procedure DoBeginWriting; override;
    procedure DoEndWriting; override;
    procedure DoWriteHeader; override;
    procedure DoWriteRecord; override;
  public
    constructor Create;
    destructor Destroy; override;
    property HeaderFont: TFont read FHeaderFont write SetHeaderFont;
    property HeaderBGColor: TColor read FHeaderBGColor write SetHeaderBGColor;
    property BodyFont: TFont read FBodyFont write SetBodyFont;
    property BodyBGColor: TColor read FBodyBGColor write SetBodyBGColor;
    property ShowGrid: Boolean read FShowGrid write SetShowGrid;
  end;

  TjbExportExcel = class(TjbExport)
  private
    CurrentCol: Integer;
    BOF: TBOF;
    Dimension: TDimension;
    Dispatcher: TDispatcher;
    FShowGrid: Boolean;

    function AddCell(vCol, vRow: Word; vAtribut: TSetOfAtribut; CellRef: TCellClass): TCell;
    procedure AddData(aData: TData);
    procedure Clear;
    procedure SetShowGrid(const Value: Boolean);
  protected
    procedure DoBeginWriting; override;
    procedure DoEndWriting; override;
    procedure DoWriteHeader; override;
    procedure DoWriteFooter; override;
    procedure DoWriteRecord; override;
  public
    procedure AddWordCell(vCol, vRow: Word; vAtribut: TSetOfAtribut; aValue: Word);
    procedure AddDoubleCell(vCol, vRow: Word; vAtribut: TSetOfAtribut; aValue: Double);
    procedure AddStrCell(vCol, vRow: Word; vAtribut: TSetOfAtribut; aValue: string);

    constructor Create;
    destructor Destroy; override;
    property ShowGrid: Boolean read FShowGrid write SetShowGrid;
  end;
{(*}
type
  TDataSetHelper = class helper for TDataSet
  public
    procedure SaveToText(AFileName: string; const ASeparator: string = ','; const ABeginString: string = '"'; AEndString: string = '"');
    procedure SaveToHTML(const AFileName: string);
    procedure SaveToXLS(const AFileName: string);
  end;
{*)}
procedure SaveToText(aDataset: TDataSet; const AFileName: string; const ASeparator: string = ','; const ABeginString: string = '"'; AEndString: string = '"');
procedure SaveToHTML(aDataset: TDataSet; const AFileName: string);
procedure SaveToXLS(aDataset: TDataSet; const AFileName: string);

implementation
uses
  ActiveX, Variants, StrUtils;
const
  {BOF}
  CBOF = $0009;
  BIT_BIFF5 = $0800;
  BIT_BIFF4 = $0400;
  BIT_BIFF3 = $0200;
  BOF_BIFF5 = CBOF or BIT_BIFF5;
  BOF_BIFF4 = CBOF or BIT_BIFF4;
  BOF_BIFF3 = CBOF or BIT_BIFF3;
  {EOF}
  BIFF_EOF = $000A;
  {Document types}
  DOCTYPE_XLS = $0010;
  DOCTYPE_XLC = $0020;
  DOCTYPE_XLM = $0040;
  DOCTYPE_XLW = $0100;
  {Dimensions}
  DIMENSIONS = $0000;
  DIMENSIONS_BIFF4 = DIMENSIONS or BIT_BIFF3;
  DIMENSIONS_BIFF3 = DIMENSIONS or BIT_BIFF3;

  { TjbExport }

constructor TjbExport.Create;
begin
  inherited;
  FFileName := '';
  FTable := nil;
end;

procedure TjbExport.DoBeginWriting;
begin
end;

procedure TjbExport.DoEndWriting;
begin
end;

procedure TjbExport.DoWriteFooter;
begin
end;

procedure TjbExport.DoWriteHeader;
begin
end;

procedure TjbExport.DoWriteRecord;
begin
end;

procedure TjbExport.Execute;
begin
  if FileName = '' then
    Exception.Create('Filename can not be empty !!!');

  Stream := TFileStream.Create(FileName, fmCreate or fmOpenReadWrite);
  try
    SaveToStream;
  finally
    FreeAndNil(Stream);
  end;
end;

function TjbExport.GetStringValue(const aField: TField): string;
  function GetValueFromVariant(const KeyValue: Variant): string;
  var
    eTmp: Extended;
  begin
    Result := VarToStr(KeyValue);

    case VarType(KeyValue) of //se system.pas, linje 89+
      varInteger, varInt64, varLongWord, varSmallInt, varByte, varWord, varShortInt, varSingle, varDouble, varCurrency:
        begin
          eTmp := KeyValue;
          Result := FloatToStr(eTmp);
        end;

      varDate:
        Result := DateToStr(KeyValue);

      varBoolean:
        Result := BoolToStr(KeyValue, True);
    end;
  end;

begin
  Result := FieldTypeNames[aField.DataType];

  case aField.DataType of
    //  ftUnknown: ;
    ftString:
      Result := aField.AsString;
    ftSmallint,
      ftInteger,
      ftWord,
      ftBoolean,
      ftFloat,
      ftCurrency:
      Result := GetValueFromVariant(aField.AsVariant);
    //    ftBCD: ;
    ftDate:
      Result := DateToStr(aField.AsDateTime);
    ftTime:
      Result := TimeToStr(aField.AsDateTime);
    ftDateTime:
      Result := DateTimeToStr(aField.AsDateTime);
    ftBytes:
      Result := GetValueFromVariant(aField.AsVariant);

    //    ftVarBytes: ;
    ftAutoInc:
      Result := GetValueFromVariant(aField.AsVariant);
    ftBlob,
      ftMemo:
      Result := aField.AsString;
    //    ftGraphic: ;
    //    ftFmtMemo: ; // 12..18
    //    ftParadoxOle: ;
    //    ftDBaseOle: ;
    //    ftTypedBinary: ;
    //    ftCursor: ;
    //    ftFixedChar: ;
    //    ftWideString: ; // 19..24
    ftLargeint:
      Result := GetValueFromVariant(aField.AsVariant);
    //    ftADT: ;
    //    ftArray: ;
    ftReference:
      Result := TReferenceField(aField).ReferenceTableName;
    //    ftDataSet: ;
    //    ftOraBlob: ;
    //    ftOraClob: ; // 25..31
    ftVariant:
      Result := VarToStr(aField.AsVariant);
    //    ftInterface: ;
    //    ftIDispatch: ;
    ftGuid:
      Result := GUIDToString(TGuidField(aField).AsGuid);
    ftTimeStamp:
      Result := DateTimeToStr(aField.AsDateTime);
    ftFMTBcd:
      Result := aField.AsString; // 32..37
    ftFixedWideChar:
      Result := aField.AsString;
    ftWideMemo:
      Result := aField.AsString;
    ftOraTimeStamp:
      Result := DateTimeToStr(aField.AsDateTime);
    ftOraInterval:
      Result := aField.AsString;
  else
    Result := aField.AsString;
  end
end;

procedure TjbExport.SaveToStream;
begin
  if Assigned(Table) then
    with FTable do
      begin
        DoBeginWriting;
        try
          TotalCount := 0;
          // write header
          DoWriteHeader;

          Table.First;
          while not Table.Eof do
            begin
              // processing record
              DoWriteRecord;
              Inc(TotalCount);

              Table.Next;
            end;

          DoWriteFooter;
        finally
          DoEndWriting;
        end;
      end;
end;

procedure TjbExport.SetTable(const Value: TjbExportWrapper);
begin
  FTable := Value;
end;

{ TjbExportText }

constructor TjbExportText.Create;
begin
  Separator := #44;
  FBeginString := #34;
  EndString := #34;
end;

procedure TjbExportText.DoWriteHeader;
var
  i: Integer;
  s: string;
begin
  inherited;
  s := '';

  for i := 0 to FTable.FieldCount - 1 do
    s := s + FTable.Fields[i].FieldName + Separator;

  Delete(s, Length(s) - (Length(Separator) - 1), Length(Separator));
  Writeln(S + sLineBreak);
end;

procedure TjbExportText.DoWriteRecord;
var
  s: string;
  Buffer: TStringList;
  i: Integer;
  aField: TField;
begin
  inherited;
  s := '';

  Buffer := TStringList.Create;
  Buffer.LineBreak := '';

  for I := 0 to FTable.FieldCount - 1 do
    begin
      aField := FTable.Fields[i];
      try
        Buffer.Add(BeginString + GetStringValue(aField) + EndString + IfThen(i = FTable.FieldCount - 1, '', FSeparator));
      except
        Buffer.Add(BeginString + '!!ERROR!!_' + aField.FieldName + EndString + IfThen(i = FTable.FieldCount - 1, '', FSeparator));
      end;
    end;

  WriteLn(Buffer.Text + sLineBreak);
  FreeAndNil(Buffer);
end;

procedure TjbExportText.WriteLn(const S: string);
begin
  Stream.WriteBuffer(PChar(S)^, Length(S));
end;

procedure SaveToXLS(aDataset: TDataSet; const AFileName: string);
begin
  with TjbExportExcel.Create do
    try
      FileName := AFileName;
      Table := TjbExportWrapper(aDataset);
      ShowGrid := False;
      Execute;
    finally
      Free;
    end;
end;

procedure SaveToHTML(aDataset: TDataSet; const AFileName: string);
begin
  with TjbExportHTML.Create do
    try
      FileName := AFileName;
      Table := TjbExportWrapper(aDataset);
      Execute;
    finally
      Free;
    end;
end;

procedure SaveToText(aDataset: TDataSet; const AFileName: string; const ASeparator: string = ','; const ABeginString: string = '"'; AEndString: string = '"');
begin
  with TjbExportText.Create do
    try
      FileName := AFileName;
      Table := TjbExportWrapper(aDataset);
      Separator := ASeparator;
      BeginString := ABeginString;
      EndString := AEndString;
      Execute;
    finally
      Free;
    end;
end;
{ TdxDBGridExportHTML }

constructor TjbExportHTML.Create;
begin
  inherited;
  FHeaderFont := TFont.Create;
  FBodyFont := TFont.Create;

  FHeaderFont.Name := 'Times New Roman';
  FHeaderFont.Size := 12;
  FBodyFont.Assign(FHeaderFont);
  FShowGrid := True;
  FHeaderBGColor := RGB($A8, $6F, $A8);
  FBodyBGColor := clWhite;
end;

destructor TjbExportHTML.Destroy;
begin
  FHeaderFont.Free;
  FBodyFont.Free;
  inherited;
end;

procedure TjbExportHTML.DoBeginWriting;
var
  StringList: TStringList;
  aColor: string;
begin
  StringList := TStringList.Create;
  StringList.Add('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');
  StringList.Add('<HTML>');
  StringList.Add('<HEAD>');
  StringList.Add('<TITLE>');
  StringList.Add(FTable.Name);
  StringList.Add('</Title>');
  StringList.Add('');
  StringList.Add('<STYLE>');
  StringList.Add('<!--');
  StringList.Add('.Header{');
  StringList.Add('  font-family: ' + FHeaderFont.Name + ';');
  StringList.Add('  font-size: ' + IntToStr(FHeaderFont.Size) + ';');
  if FHeaderFont.Color = clNone then
    aColor := '000000'
  else
    aColor := IntToHex(ColorToRGB(FHeaderFont.Color), 6);

  StringList.Add('  font-color: #' + aColor + ';');

  if FHeaderBGColor = clNone then
    aColor := '000000'
  else
    aColor := IntToHex(ColorToRGB(FHeaderBGColor), 6);

  StringList.Add('  background-color : ' + aColor + ';');
  StringList.Add('}');
  StringList.Add('');
  StringList.Add('TD  {');
  StringList.Add('  font-family: ' + FBodyFont.Name + ';');
  StringList.Add('  font-size: ' + IntToStr(FBodyFont.Size) + ';');

  if FHeaderFont.Color = clNone then
    aColor := '000000'
  else
    aColor := IntToHex(ColorToRGB(FBodyFont.Color), 6);

  StringList.Add('  font-color: ' + aColor + ';');

  if FBodyBGColor = clNone then
    aColor := '000000'
  else
    aColor := IntToHex(ColorToRGB(FBodyBGColor), 6);

  StringList.Add('  background-color : ' + aColor + ';');
  StringList.Add('}');
  StringList.Add('-->');
  StringList.Add('</STYLE>');

  WriteLn(StringList.Text);
  StringList.Free;
end;

procedure TjbExportHTML.DoEndWriting;
begin
  WriteLn('    </TABLE>');
  WriteLn('  </TD>');
  WriteLn('  </TR>');
  WriteLn('</TABLE>');
  WriteLn('</Body>');
  WriteLn('</HTML>');
end;

procedure TjbExportHTML.DoWriteHeader;
var
  i: Integer;
  StringList: TStringList;
  Border: string;
begin
  if ShowGrid then
    Border := '1'
  else
    Border := '0';

  StringList := TStringList.Create;
  StringList.Add('');
  StringList.Add('<BODY BGCOLOR=#C0C0C0>');
  StringList.Add('');
  StringList.Add('<TABLE BORDER=' + Border + ' CELLSPACING=0 CELLPADDING=1 BGCOLOR=#C0C0C0 Width = 100%>');
  StringList.Add('<TR>');
  StringList.Add('  <TD>');
  StringList.Add('    <TABLE BORDER=' + Border + ' CELLSPACING=0 CELLPADDING=1 BGCOLOR=#C0C0C0 Width = 100%>');
  StringList.Add('      <TR VALIGN="TOP" class="Header">');

  for i := 0 to FTable.FieldCount - 1 do
    StringList.Add('        <TD NOWRAP  class="Header">' + FTable.Fields[i].FieldName + '</TD>');

  StringList.Add('<TR>');
  StringList.Add('');

  WriteLn(StringList.Text);

  StringList.Free;
end;

procedure TjbExportHTML.DoWriteRecord;
var
  s, s1: string;
  i: Integer;
begin
  inherited;
  s := '';

  WriteLn('      <TR>');
  for i := 0 to FTable.FieldCount - 1 do
    begin
      S1 := FTable.Fields[i].AsString;
      s := '        <TD NOWRAP>' + S1 + '</TD>';
      WriteLn(s);
    end;
  WriteLn('      </TR>');
end;

procedure TjbExportHTML.SetBodyBGColor(const Value: TColor);
begin
  FBodyBGColor := Value;
end;

procedure TjbExportHTML.SetBodyFont(const Value: Tfont);
begin
  FBodyFont := Value;
end;

procedure TjbExportHTML.SetHeaderBGColor(const Value: TColor);
begin
  FHeaderBGColor := Value;
end;

procedure TjbExportHTML.SetHeaderFont(const Value: TFont);
begin
  FHeaderFont := Value;
end;

procedure TjbExportHTML.SetShowGrid(const Value: Boolean);
begin
  FShowGrid := Value;
end;

procedure TjbExportHTML.WriteLn(S: string);
begin
  S := S + #13#10;
  Stream.WriteBuffer(PChar(S)^, Length(S));
end;

{ TjbExportExcel }

function TjbExportExcel.AddCell(vCol, vRow: Word; vAtribut: TSetOfAtribut; CellRef: TCellClass): TCell;
var
  aCell: TCell;
begin
  aCell := CellRef.Create;
  with aCell do
    begin
      Col := vCol - 1;
      Row := vRow - 1;
      Atribut := vAtribut;
    end;

  AddData(aCell);
  Result := aCell;
end;

procedure TjbExportExcel.AddData(aData: TData);
begin
  Dispatcher.RegisterObj(aData);
end;

procedure TjbExportExcel.AddDoubleCell(vCol, vRow: Word; vAtribut: TSetOfAtribut; aValue: Double);
begin
  with TDoubleCell(AddCell(vCol, vRow, vAtribut, TDoubleCell)) do
    Value := aValue;
end;

procedure TjbExportExcel.AddStrCell(vCol, vRow: Word; vAtribut: TSetOfAtribut; aValue: string);
begin
  with TStrCell(AddCell(vCol, vRow, vAtribut, TStrCell)) do
    Value := aValue;
end;

procedure TjbExportExcel.AddWordCell(vCol, vRow: Word; vAtribut: TSetOfAtribut; aValue: Word);
begin
  with TWordCell(AddCell(vCol, vRow, vAtribut, TWordCell)) do
    Value := aValue;
end;

procedure TjbExportExcel.Clear;
begin
  Dispatcher.Clear;
  BOF := TBOF.Create;
  Dimension := TDimension.Create;
  Dispatcher.RegisterObj(BOF);
  Dispatcher.RegisterObj(Dimension);
  CurrentCol := 1;
end;

constructor TjbExportExcel.Create;
begin
  Dispatcher := TDispatcher.Create;
  Dispatcher.OpcodeEOF := BIFF_EOF;
  Clear;
end;

destructor TjbExportExcel.Destroy;
begin
  Dispatcher.Free;
end;

procedure TjbExportExcel.DoBeginWriting;
begin

end;

procedure TjbExportExcel.DoEndWriting;
begin
  Dispatcher.Stream := Stream;
  Dispatcher.Write;
end;

procedure TjbExportExcel.DoWriteFooter;
begin
  inherited;
end;

procedure TjbExportExcel.DoWriteHeader;
var
  i: Integer;
  SetAtribut: TSetOfAtribut;
begin
  SetAtribut := [acShaded, acBottomBorder, acTopBorder, acLeftBorder, acRightBorder, acLeft];

  for i := 0 to FTable.FieldCount - 1 do
    AddStrCell(i + 1, CurrentCol, SetAtribut, FTable.Fields[i].FieldName);

  inc(CurrentCol);
end;

procedure TjbExportExcel.DoWriteRecord;
var
  i: Integer;
  SetAtribut: TSetOfAtribut;
begin
  inc(CurrentCol);

  if FShowGrid then
    SetAtribut := [acBottomBorder, acTopBorder, acLeftBorder, acRightBorder, acLeft]
  else
    SetAtribut := [];

  for i := 0 to FTable.FieldCount - 1 do
    AddStrCell(i + 1, CurrentCol, SetAtribut, FTable.Fields[i].AsString);
end;

procedure TjbExportExcel.SetShowGrid(const Value: Boolean);
begin
  FShowGrid := Value;
end;

{ TjbWriter }

procedure TjbWriter.WriteByte(B: Byte);
begin
  Stream.Write(B, 1);
end;

procedure TjbWriter.WriteDouble(D: Double);
begin
  Stream.Write(D, 8);
end;

procedure TjbWriter.WriteInt(I: Integer);
begin
  Stream.Write(I, 4);
end;

procedure TjbWriter.WriteSingleStr(const S: string);
var
  Tmp: string;
begin
  if s = '' then
    begin
      Tmp := #32;
      Stream.Write(Tmp[1], 1)
    end
  else
    Stream.Write(S[1], Length(S));
end;

procedure TjbWriter.WriteStr(const S: string);
{req: s shouldn't exceed 64KB}
var
  Tmp: string;
  Len: Integer;
begin
  if s = '' then
    begin
      Tmp := #32;
      WriteWord(1);
      Stream.Write(Tmp[1], 1)
    end
  else
    begin
      Len := Length(S);
      WriteWord(Len);
      Stream.Write(s[1], Len);
    end;
end;

procedure TjbWriter.WriteWord(W: Word);
begin
  Stream.Write(w, 2);
end;

{ TDispatcher }

procedure TDispatcher.Clear;
var
  I: Integer;
begin
  for i := 0 to StrList.Count - 1 do
    TjbPersistent(StrList.Objects[i]).Free;

  StrList.Clear;
  SLError.Clear;
end;

constructor TDispatcher.Create;
begin
  OpCodeEOF := 999;
  StrList := TStringList.Create;
  Writer := TjbWriter.Create;
  SLError := TStringList.Create;
end;

destructor TDispatcher.Destroy;
begin
  Clear;
  StrList.Free;
  Writer.Free;
  SLError.Free;
  inherited;
end;

procedure TDispatcher.RegisterObj(jbPers: TjbPersistent);
begin
  StrList.AddObject(IntToStr(jbPers.opCode), jbPers);
end;

procedure TDispatcher.SetStream(vStream: TStream);
begin
  FStream := vStream;
  Writer.Stream := FStream;
end;

procedure TDispatcher.Write;
var
  i: Integer;
  Pos, Len: Integer;
begin
  for i := 0 to StrList.Count - 1 do
    begin
      Writer.WriteWord(TjbPersistent(StrList.objects[i]).Opcode);
      Writer.WriteWord(0);
      pos := Stream.Position;
      TjbPersistent(StrList.Objects[i]).Write(Writer);

      Len := Stream.Position - Pos;
      Stream.Seek(-(Len + 2), soFromCurrent);
      Writer.WriteWord(Len);
      Stream.Seek(Len, soFromCurrent);
    end;

  Writer.WriteWord(opCodeEOF);
  Writer.WriteWord(0);
end;

{ TBOF }

constructor TBOF.Create;
begin
  opCOde := BOF_BIFF5;
end;

procedure TBOF.Write(aWriter: TjbWriter);
begin
  with aWriter do
    begin
      WriteWord(0);
      WriteWord(DOCTYPE_XLS);
      WriteWord(0);
    end;
end;

{ TDimension }

constructor TDimension.Create;
begin
  opCode := DIMENSIONS;
  MinSaveRecs := 0;
  MaxSaveRecs := 1000;
  MinSaveCols := 0;
  MaxSaveCols := 100;
end;

procedure TDimension.Write(aWriter: TjbWriter);
begin
  with aWriter do
    begin
      WriteWord(MinSaveRecs);
      WriteWord(MaxSaveRecs);
      WriteWord(MinSaveCols);
      WriteWord(MaxSaveCols);
    end;
end;

{ TCell }

procedure TCell.SetAtribut(Value: TSetOfAtribut);
var
  i: Integer;
begin
  //reset
  for i := 0 to High(FAtribut) do
    FAtribut[i] := 0;

  {
  Byte Offset     Bit   Description                     Contents
  0               7     Cell is not hidden              0b
                        Cell is hidden                  1b
                  6     Cell is not locked              0b
                        Cell is locked                  1b
                  5-0   Reserved, must be 0             000000b
  1               7-6   Font number (4 possible)
                  5-0   Cell format code
  2               7     Cell is not shaded              0b
                        Cell is shaded                  1b
                  6     Cell has no bottom border       0b
                        Cell has a bottom border        1b
                  5     Cell has no top border          0b
                        Cell has a top border           1b
                  4     Cell has no right border        0b
                        Cell has a right border         1b
                  3     Cell has no left border         0b
                        Cell has a left border          1b
                  2-0   Cell alignment code
                             general                    000b
                             left                       001b
                             center                     010b
                             right                      011b
                             fill                       100b
                             Multiplan default align.   111b
  }

  //  bit sequence 76543210

  if acHidden in Value then //byte 0 bit 7:
    FAtribut[0] := FAtribut[0] + 128;

  if acLocked in Value then //byte 0 bit 6:
    FAtribut[0] := FAtribut[0] + 64;

  if acShaded in Value then //byte 2 bit 7:
    FAtribut[2] := FAtribut[2] + 128;

  if acBottomBorder in Value then //byte 2 bit 6
    FAtribut[2] := FAtribut[2] + 64;

  if acTopBorder in Value then //byte 2 bit 5
    FAtribut[2] := FAtribut[2] + 32;

  if acRightBorder in Value then //byte 2 bit 4
    FAtribut[2] := FAtribut[2] + 16;

  if acLeftBorder in Value then //byte 2 bit 3
    FAtribut[2] := FAtribut[2] + 8;

  if acLeft in Value then //byte 2 bit 1
    FAtribut[2] := FAtribut[2] + 1
  else if acCenter in Value then //byte 2 bit 1
    FAtribut[2] := FAtribut[2] + 2
  else if acRight in Value then //byte 2, bit 0 dan bit 1
    FAtribut[2] := FAtribut[2] + 3;

  if acFill in Value then //byte 2, bit 0
    FAtribut[2] := FAtribut[2] + 4;
end;

procedure TCell.Write(aWrite: TjbWriter);
var
  i: Integer;
begin
  with aWrite do
    begin
      WriteWord(Row);
      WriteWord(Col);
      for i := 0 to 2 do
        WriteByte(FAtribut[i]);
    end;
end;

{ TBlankCell }

constructor TBlankCell.Create;
begin
  opCode := 1;
end;

procedure TBlankCell.Write(aWriter: TjbWriter);
begin
  inherited;
end;

{ TDoubleCell }

constructor TDoubleCell.Create;
begin
  opCode := 3;
end;

procedure TDoubleCell.Write(aWriter: TjbWriter);
begin
  inherited;
  aWriter.WriteDouble(Value);
end;

{ TWordCell }

constructor TWordCell.Create;
begin
  opCode := 2;
end;

procedure TWordCell.Write(aWriter: TjbWriter);
begin
  inherited;
  aWriter.WriteWord(Value);
end;

{ TStrCell }

constructor TStrCell.Create;
begin
  opCode := 4;
end;

procedure TStrCell.Write(aWriter: TjbWriter);
begin
  inherited;
  aWriter.WriteByte(Length(Value));
  aWriter.WriteSingleStr(Value);
end;

{ TDataSetHelper }

procedure TDataSetHelper.SaveToHTML(const AFileName: string);
begin
  DataSetExport.SaveToHTML(Self, AFileName);
end;

procedure TDataSetHelper.SaveToText(AFileName: string; const ASeparator, ABeginString: string; AEndString: string);
begin
  DataSetExport.SaveToText(Self, AFileName, ASeparator, ABeginString, AEndString);
end;

procedure TDataSetHelper.SaveToXLS(const AFileName: string);
begin
  DataSetExport.SaveToXLS(Self, AFileName);
end;

end.