unit jkSYLK;

{-------------------------------------------------------------------------------
Author:      Jan Krieger, Ismaning (Munich), Germany
             jan@jkrieger.de
             http://www.jkrieger.de/
Date:        June 10./11. 2000
Name:        unit jkSYLK;
Version:     1.0
Copyright:   (c) 2000 by Jan W. Krieger. All rights reserved.
Description: unit with procedures to save spreadsheet data as SYLK-files
             (may be read by MS EXCEL)
Status:      This unit is FREEWARE, so no support can be granted
             Everybody may feel free to copy and use it.
             If you alter the sourcecode, it would be kind to send me the
             new source!

--------------------------------------------------------------------------------
                   This comment may not be deleted !!!
--------------------------------------------------------------------------------}

interface

uses sysutils;

const
  jkSYLK_FileExt = '.slk'; //fileextention for SYLK-Files

type tSYLKFile = text;

procedure jkSYLK_CreateFile(var f:tSYLKFile; Filename, progname:string);
// creates a new SYLK file
// and writes the 'ID'-RTD which contains the name of the program [progname] that created the file

procedure jkSYLK_CloseFile(var f:tSYLKFile);
// closes a SYLK file (writes the 'E'-RTD)

procedure jkSYLK_WriteCell(var f:tSYLKFile; x,y:int64; value:longint); overload;
procedure jkSYLK_WriteCell(var f:tSYLKFile; x,y:int64; value:string); overload;
procedure jkSYLK_WriteCell(var f:tSYLKFile; x,y:int64; value:extended); overload;
procedure jkSYLK_WriteCell(var f:tSYLKFile; x,y:int64; value:boolean); overload;
// these procedures write one cell into the SYLK file

procedure jkSYLK_WriteBoundaries(var f:tSYLKFile; x,y:int64);
// writes the boundaries of the cells

function jkSYLK_FormatString(s:string):string;
// tool function to format a string to be saved in a SYLK file

implementation

function jkSYLK_FormatString(s:string):string;
var tmp:string;
begin
  tmp:=s;

  tmp:=StringReplace(tmp,';',';;',[rfReplaceAll, rfIgnoreCase]); // semicolons need to be doubled (reserved character)

  tmp:=StringReplace(tmp,#10,'',[rfReplaceAll, rfIgnoreCase]); // linefeed and carriage return characters need to be deleted
  tmp:=StringReplace(tmp,#13,'',[rfReplaceAll, rfIgnoreCase]); //   -- '' --

  result:=tmp;
end;

procedure jkSYLK_CreateFile(var f:tSYLKFile; Filename, progname:string);
begin
  AssignFile(f,Filename);
  Rewrite(f);
  WriteLn(f, 'ID;P'+jkSYLK_FormatString(progname));
end;

procedure jkSYLK_CloseFile(var f:tSYLKFile);
begin
  WriteLn(f, 'E');
  CloseFile(f);
end;

procedure jkSYLK_WriteCell(var f:tSYLKFile; x,y:int64; value:longint);
begin
  WriteLn(f,'C;X'+inttostr(x)+';Y'+inttostr(y)+';K'+inttostr(value));
end;

procedure jkSYLK_WriteCell(var f:tSYLKFile; x,y:int64; value:string);
begin
  WriteLn(f,'C;X'+inttostr(x)+';Y'+inttostr(y)+';K"'+jkSYLK_FormatString(value)+'"');
end;

procedure jkSYLK_WriteCell(var f:tSYLKFile; x,y:int64; value:extended);
begin
  WriteLn(f,'C;X'+inttostr(x)+';Y'+inttostr(y)+';K'+stringreplace(FloatToStrF(value,ffGeneral,18,4),',', '.',[rfReplaceAll, rfIgnoreCase]));
end;

procedure jkSYLK_WriteCell(var f:tSYLKFile; x,y:int64; value:boolean);
var s:string;
begin
  s:='"TRUE"';
  if not value then s:='"FALSE"';
  WriteLn(f,'C;X'+inttostr(x)+';Y'+inttostr(y)+';K'+s);
end;

procedure jkSYLK_WriteBoundaries(var f:tSYLKFile; x,y:int64);
begin
  WriteLn(f,'B;X'+inttostr(x)+';Y'+inttostr(y));
end;


end.