Adds excel 8 writting example and starts implementing formatting

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1264 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/excel5demo/excel5write.lpi

@@ -15,7 +15,7 @@
       <UseAppBundle Value="False"/>
     </General>
     <VersionInfo>
-      <ProjectVersion Value=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
     </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>

components/fpspreadsheet/examples/excel5demo/excel5write.lpr

@@ -11,8 +11,16 @@ program excel5write;
 
 uses
   Classes, SysUtils, fpspreadsheet, xlsbiff5,
-  laz_fpspreadsheet;
+  laz_fpspreadsheet, fpsconvencoding;
 
+const
+  Str_First = 'First';
+  Str_Second = 'Second';
+  Str_Third = 'Third';
+  Str_Fourth = 'Fourth';
+  Str_Worksheet1 = 'Meu Relatório';
+  Str_Worksheet2 = 'My Worksheet 2';
+  Str_Total = 'Total:';
 var
   MyWorkbook: TsWorkbook;
   MyWorksheet: TsWorksheet;
@@ -24,14 +32,14 @@ begin
 
   // Create the spreadsheet
   MyWorkbook := TsWorkbook.Create;
-  MyWorksheet := MyWorkbook.AddWorksheet('Meu Relatório');
+  MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
 
   // Write some cells
   MyWorksheet.WriteNumber(0, 0, 1.0);// A1
   MyWorksheet.WriteNumber(0, 1, 2.0);// B1
   MyWorksheet.WriteNumber(0, 2, 3.0);// C1
   MyWorksheet.WriteNumber(0, 3, 4.0);// D1
-  MyWorksheet.WriteUTF8Text(4, 2, 'Total:');// C5
+  MyWorksheet.WriteUTF8Text(4, 2, Str_Total);// C5
   MyWorksheet.WriteNumber(4, 3, 10);        // D5
 
 { Uncommend this to test large XLS files
@@ -66,13 +74,13 @@ begin
   //MyFormula.FormulaStr := '';
 
   // Creates a new worksheet
-  MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2');
+  MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2);
 
-{  // Write some string cells
+  // Write some string cells
-  MyWorksheet.WriteUTF8Text(0, 0, 'First');
+  MyWorksheet.WriteUTF8Text(0, 0, Str_First);
-  MyWorksheet.WriteUTF8Text(0, 1, 'Second');
+  MyWorksheet.WriteUTF8Text(0, 1, Str_Second);
-  MyWorksheet.WriteUTF8Text(0, 2, 'Third');
+  MyWorksheet.WriteUTF8Text(0, 2, Str_Third);
-  MyWorksheet.WriteUTF8Text(0, 3, 'Fourth');}
+  MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth);
 
   // Save the spreadsheet to a file
   MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel5, False);

components/fpspreadsheet/examples/excel8demo/excel8write.lpi

@@ -0,0 +1,56 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <AlwaysBuild Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=".exe"/>
+      <Title Value="excel8write"/>
+      <UseAppBundle Value="False"/>
+    </General>
+    <VersionInfo>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="laz_fpspreadsheet"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="excel8write.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="excel8write"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="..\"/>
+      <SrcPath Value="..\"/>
+    </SearchPaths>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

components/fpspreadsheet/examples/excel8demo/excel8write.lpr

@@ -0,0 +1,90 @@
+{
+excel8write.dpr
+
+Demonstrates how to write an Excel 8+ file using the fpspreadsheet library
+
+AUTHORS: Felipe Monteiro de Carvalho
+}
+program excel8write;
+
+{$mode delphi}{$H+}
+
+uses
+  Classes, SysUtils, fpspreadsheet, xlsbiff8,
+  laz_fpspreadsheet, fpsconvencoding;
+
+const
+  Str_First = 'First';
+  Str_Second = 'Second';
+  Str_Third = 'Third';
+  Str_Fourth = 'Fourth';
+  Str_Worksheet1 = 'Meu Relatório';
+  Str_Worksheet2 = 'My Worksheet 2';
+  Str_Total = 'Total:';
+var
+  MyWorkbook: TsWorkbook;
+  MyWorksheet: TsWorksheet;
+  MyRPNFormula: TsRPNFormula;
+  MyDir: string;
+  i: Integer;
+begin
+  MyDir := ExtractFilePath(ParamStr(0));
+
+  // Create the spreadsheet
+  MyWorkbook := TsWorkbook.Create;
+  MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
+
+  // Write some cells
+  MyWorksheet.WriteNumber(0, 0, 1.0);// A1
+  MyWorksheet.WriteNumber(0, 1, 2.0);// B1
+  MyWorksheet.WriteNumber(0, 2, 3.0);// C1
+  MyWorksheet.WriteNumber(0, 3, 4.0);// D1
+  MyWorksheet.WriteUTF8Text(4, 2, Str_Total);// C5
+  MyWorksheet.WriteNumber(4, 3, 10);        // D5
+
+{ Uncommend this to test large XLS files
+  for i := 2 to 20 do
+  begin
+    MyWorksheet.WriteAnsiText(i, 0, ParamStr(0));
+    MyWorksheet.WriteAnsiText(i, 1, ParamStr(0));
+    MyWorksheet.WriteAnsiText(i, 2, ParamStr(0));
+    MyWorksheet.WriteAnsiText(i, 3, ParamStr(0));
+  end;
+}
+
+  // Write the formula E1 = A1 + B1
+  SetLength(MyRPNFormula, 3);
+  MyRPNFormula[0].ElementKind := fekCell;
+  MyRPNFormula[0].Col := 0;
+  MyRPNFormula[0].Row := 0;
+  MyRPNFormula[1].ElementKind := fekCell;
+  MyRPNFormula[1].Col := 1;
+  MyRPNFormula[1].Row := 0;
+  MyRPNFormula[2].ElementKind := fekAdd;
+  MyWorksheet.WriteRPNFormula(0, 4, MyRPNFormula);
+
+  // Write the formula F1 = ABS(A1)
+  SetLength(MyRPNFormula, 2);
+  MyRPNFormula[0].ElementKind := fekCell;
+  MyRPNFormula[0].Col := 0;
+  MyRPNFormula[0].Row := 0;
+  MyRPNFormula[1].ElementKind := fekABS;
+  MyWorksheet.WriteRPNFormula(0, 5, MyRPNFormula);
+
+  //MyFormula.FormulaStr := '';
+
+  // Creates a new worksheet
+  MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2);
+
+  // Write some string cells
+  MyWorksheet.WriteUTF8Text(0, 0, Str_First);
+  MyWorksheet.WriteUTF8Text(0, 1, Str_Second);
+  MyWorksheet.WriteUTF8Text(0, 2, Str_Third);
+  MyWorksheet.WriteUTF8Text(0, 3, Str_Fourth);
+  MyWorksheet.WriteTextRotation(0, 0, rt90DegreeClockwiseRotation);
+
+  // Save the spreadsheet to a file
+  MyWorkbook.WriteToFile(MyDir + 'test2.xls', sfExcel8, False);
+  MyWorkbook.Free;
+end.
+

components/fpspreadsheet/fpsopendocument.pas

@@ -71,7 +71,7 @@ type
     procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
     { Record writing methods }
     procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override;
-    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
+    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string; ACell: PCell); override;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
   end;
 
@@ -537,7 +537,7 @@ begin
 end;
 
 procedure TsSpreadOpenDocWriter.WriteLabel(AStream: TStream; const ARow,
-  ACol: Word; const AValue: string);
+  ACol: Word; const AValue: string; ACell: PCell);
 begin
   // The row should already be the correct one
   FContent := FContent +

components/fpspreadsheet/fpspreadsheet.pas

@@ -14,7 +14,7 @@ unit fpspreadsheet;
 interface
 
 uses
-  Classes, SysUtils, AVL_Tree;
+  Classes, SysUtils, AVL_Tree, fpsconvencoding;
 
 type
   TsSpreadsheetFormat = (sfExcel2, sfExcel3, sfExcel4, sfExcel5, sfExcel8,
@@ -28,6 +28,17 @@ const
 
 type
 
+  {@@ Possible encodings for a non-unicode encoded text }
+  TsEncoding = (
+    seLatin1,
+    seLatin2,
+    seCyrillic,
+    seGreek,
+    seTurkish,
+    seHebrew,
+    seArabic
+    );
+
   {@@ Describes a formula
 
     Supported syntax:
@@ -72,8 +83,22 @@ type
 
   {@@ Describes the type of content of a cell on a TsWorksheet }
 
-  TCellContentType = (cctEmpty, cctFormula, cctRPNFormula, cctNumber, cctUTF8String);
+  TCellContentType = (cctEmpty, cctFormula, cctRPNFormula, cctNumber,
-  
+    cctUTF8String);
+
+  {@@ List of possible formatting fields }
+
+  TsUsedFormattingField = (uffTextRotation);
+
+  {@@ Describes which formatting fields are active }
+
+  TsUsedFormattingFields = set of TsUsedFormattingField;
+
+  {@@ Text rotation formatting}
+
+  TsTextRotation = (trHorizontal, rt90DegreeClockwiseRotation,
+    rt90DegreeCounterClockwiseRotation);
+
   {@@ Cell structure for TsWorksheet
 
       Never suppose that all *Value fields are valid,
@@ -92,6 +117,9 @@ type
     RPNFormulaValue: TsRPNFormula;
     NumberValue: double;
     UTF8StringValue: ansistring;
+    { Formatting fields }
+    UsedFormattingFields: TsUsedFormattingFields;
+    TextRotation: TsTextRotation;
   end;
 
   PCell = ^TCell;
@@ -128,6 +156,7 @@ type
     procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double);
     procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
     procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula);
+    procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
     property  Cells: TAVLTree read FCells;
   end;
 
@@ -137,6 +166,7 @@ type
   private
     { Internal data }
     FWorksheets: TFPList;
+    FEncoding: TsEncoding;
     { Internal methods }
     procedure RemoveCallback(data, arg: pointer);
   public
@@ -157,6 +187,9 @@ type
     function  GetWorksheetByIndex(AIndex: Cardinal): TsWorksheet;
     function  GetWorksheetCount: Cardinal;
     procedure RemoveAllWorksheets;
+    {@@ This property is only used for formats which don't support unicode
+      and support a single encoding for the whole document, like Excel 2 to 5 }
+    property Encoding: TsEncoding read FEncoding write FEncoding;
   end;
 
   {@@ TsSpreadReader class reference type }
@@ -198,7 +231,7 @@ type
     { Record writing methods }
     procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); virtual;
     procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsRPNFormula); virtual;
-    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); virtual; abstract;
+    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string; ACell: PCell); virtual; abstract;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); virtual; abstract;
   end;
 
@@ -542,12 +575,12 @@ end;
 {@@
   Writes UTF-8 encoded text to a determined cell.
 
-  On formats that only support unicode the text will be converted
+  On formats that don't support unicode, the text will be converted
-  to the unicode encoding that the format supports.
+  to ISO Latin 1.
 
   @param  ARow      The row of the cell
   @param  ACol      The column of the cell
-  @param  AText     The text to be written encoded with the system encoding
+  @param  AText     The text to be written encoded in utf-8
 }
 procedure TsWorksheet.WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring);
 var
@@ -604,6 +637,26 @@ begin
   ACell^.RPNFormulaValue := AFormula;
 end;
 
+{@@
+  Adds text rotation to the formatting of a cell
+
+  @param  ARow      The row of the cell
+  @param  ACol      The column of the cell
+  @param  ARotation How to rotate the text
+
+  @see    TsTextRotation
+}
+procedure TsWorksheet.WriteTextRotation(ARow, ACol: Cardinal;
+  ARotation: TsTextRotation);
+var
+  ACell: PCell;
+begin
+  ACell := GetCell(ARow, ACol);
+
+  Include(ACell^.UsedFormattingFields, uffTextRotation);
+  ACell^.TextRotation := ARotation;
+end;
+
 { TsWorkbook }
 
 {@@
@@ -916,7 +969,7 @@ begin
 
   case ACell.ContentType of
     cctNumber:  WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue);
-    cctUTF8String:  WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue);
+    cctUTF8String:  WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
     cctFormula: WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell^.FormulaValue);
     cctRPNFormula: WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue);
   end;

components/fpspreadsheet/xlsbiff2.pas

@@ -65,7 +65,7 @@ type
     procedure WriteBOF(AStream: TStream);
     procedure WriteEOF(AStream: TStream);
     procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsRPNFormula); override;
-    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
+    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string; ACell: PCell); override;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
   end;
 
@@ -279,7 +279,7 @@ end;
 *
 *******************************************************************}
 procedure TsSpreadBIFF2Writer.WriteLabel(AStream: TStream; const ARow,
-  ACol: Word; const AValue: string);
+  ACol: Word; const AValue: string; ACell: PCell);
 var
   L: Byte;
   AnsiText: ansistring;

components/fpspreadsheet/xlsbiff5.pas

@@ -103,6 +103,7 @@ type
 
   TsSpreadBIFF5Writer = class(TsCustomSpreadWriter)
   private
+    WorkBookEncoding: TsEncoding;
     function  FEKindToExcelID(AElement: TFEKind; var AParamsNum: Byte; var AExtra: Word): Byte;
   public
 //    constructor Create;
@@ -114,12 +115,13 @@ type
     { Record writing methods }
     procedure WriteBOF(AStream: TStream; ADataType: Word);
     function  WriteBoundsheet(AStream: TStream; ASheetName: string): Int64;
+    procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding);
     procedure WriteDimensions(AStream: TStream);
     procedure WriteEOF(AStream: TStream);
     procedure WriteFont(AStream: TStream;  AFont: TFPCustomFont);
     procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsRPNFormula); override;
     procedure WriteIndex(AStream: TStream);
-    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
+    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string; ACell: PCell); override;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
     procedure WriteStyle(AStream: TStream);
     procedure WriteWindow1(AStream: TStream);
@@ -147,6 +149,7 @@ const
   INT_EXCEL_ID_RSTRING    = $00D6;
   INT_EXCEL_ID_RK         = $027E;
   INT_EXCEL_ID_MULRK      = $00BD;
+  INT_EXCEL_ID_CODEPAGE   = $0042;
 
   { Cell Addresses constants }
   MASK_EXCEL_ROW          = $3FFF;
@@ -164,9 +167,44 @@ const
   INT_BOF_BUILD_ID        = $1FD2;
   INT_BOF_BUILD_YEAR      = $07CD;
 
+  { CODEPAGE record constants }
+
+  WORD_ASCII = 367;
+  WORD_UTF_16 = 1200; // BIFF 8
+  WORD_CP_1250_Latin2 = 1250;
+  WORD_CP_1251_Cyrillic = 1251;
+  WORD_CP_1252_Latin1 = 1252; // BIFF4-BIFF5
+  WORD_CP_1253_Greek = 1253;
+  WORD_CP_1254_Turkish = 1254;
+  WORD_CP_1255_Hebrew = 1255;
+  WORD_CP_1256_Arabic = 1256;
+  WORD_CP_1257_Baltic = 1257;
+  WORD_CP_1258_Vietnamese = 1258;
+  WORD_CP_1258_Latin1_BIFF2_3 = 32769; // BIFF2-BIFF3
+
   { FONT record constants }
   INT_FONT_WEIGHT_NORMAL  = $0190;
 
+  BYTE_ANSILatin1         = $00;
+  BYTE_SYSTEM_DEFAULT     = $01;
+  BYTE_SYMBOL             = $02;
+  BYTE_Apple_Roman        = $4D;
+  BYTE_ANSI_Japanese_Shift_JIS = $80;
+  BYTE_ANSI_Korean_Hangul = $81;
+  BYTE_ANSI_Korean_Johab  = $81;
+  BYTE_ANSI_Chinese_Simplified_GBK = $86;
+  BYTE_ANSI_Chinese_Traditional_BIG5 = $88;
+  BYTE_ANSI_Greek         = $A1;
+  BYTE_ANSI_Turkish       = $A2;
+  BYTE_ANSI_Vietnamese    = $A3;
+  BYTE_ANSI_Hebrew        = $B1;
+  BYTE_ANSI_Arabic        = $B2;
+  BYTE_ANSI_Baltic        = $BA;
+  BYTE_ANSI_Cyrillic      = $CC;
+  BYTE_ANSI_Thai          = $DE;
+  BYTE_ANSI_Latin2        = $EE;
+  BYTE_OEM_Latin1         = $FF;
+
   { FORMULA record constants }
   MASK_FORMULA_RECALCULATE_ALWAYS  = $0001;
   MASK_FORMULA_RECALCULATE_ON_OPEN = $0002;
@@ -318,10 +356,15 @@ var
   Boundsheets: array of Int64;
   i, len: Integer;
 begin
+  { Store some data about the workbook that other routines need }
+  WorkBookEncoding := AData.Encoding;
+
   { Write workbook globals }
 
   WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
 
+  WriteCodepage(AStream, WorkBookEncoding);
+
   WriteWindow1(AStream);
 
   FontData := TFPCustomFont.Create;
@@ -486,6 +529,29 @@ begin
   AStream.WriteBuffer(LatinSheetName[1], Len);
 end;
 
+procedure TsSpreadBIFF5Writer.WriteCodepage(AStream: TStream; AEncoding: TsEncoding);
+var
+  lCodepage: Word;
+begin
+  { BIFF Record header }
+  AStream.WriteWord(WordToLE(INT_EXCEL_ID_CODEPAGE));
+  AStream.WriteWord(WordToLE(2));
+
+  { Codepage }
+  case AEncoding of
+    seLatin2:   lCodepage := WORD_CP_1250_Latin2;
+    seCyrillic: lCodepage := WORD_CP_1251_Cyrillic;
+    seGreek:    lCodepage := WORD_CP_1253_Greek;
+    seTurkish:  lCodepage := WORD_CP_1254_Turkish;
+    seHebrew:   lCodepage := WORD_CP_1255_Hebrew;
+    seArabic:   lCodepage := WORD_CP_1256_Arabic;
+  else
+    // Default is Latin1
+    lCodepage := WORD_CP_1252_Latin1;
+  end;
+  AStream.WriteWord(WordToLE(lCodepage));
+end;
+
 {*******************************************************************
 *  TsSpreadBIFF5Writer.WriteIndex ()
 *
@@ -735,12 +801,23 @@ end;
 *
 *******************************************************************}
 procedure TsSpreadBIFF5Writer.WriteLabel(AStream: TStream; const ARow,
-  ACol: Word; const AValue: string);
+  ACol: Word; const AValue: string; ACell: PCell);
 var
   L: Word;
   AnsiValue: ansistring;
 begin
-  AnsiValue := UTF8ToISO_8859_1(AValue);
+  case WorkBookEncoding of
+  seLatin2:   AnsiValue := UTF8ToCP1250(AValue);
+  seCyrillic: AnsiValue := UTF8ToCP1251(AValue);
+  seGreek:    AnsiValue := UTF8ToCP1253(AValue);
+  seTurkish:  AnsiValue := UTF8ToCP1254(AValue);
+  seHebrew:   AnsiValue := UTF8ToCP1255(AValue);
+  seArabic:   AnsiValue := UTF8ToCP1256(AValue);
+  else
+    // Latin 1 is the default
+    AnsiValue := UTF8ToCP1252(AValue);
+  end;
+
   if AnsiValue = '' then
   begin
     // Bad formatted UTF8String (maybe ANSI?)

components/fpspreadsheet/xlsbiff8.pas

@@ -114,15 +114,16 @@ type
     function  WriteBoundsheet(AStream: TStream; ASheetName: string): Int64;
     procedure WriteDimensions(AStream: TStream);
     procedure WriteEOF(AStream: TStream);
-    procedure WriteFont(AStream: TStream;  AFont: TFPCustomFont);
+    procedure WriteFont(AStream: TStream; AFont: TFPCustomFont);
     procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override;
     procedure WriteIndex(AStream: TStream);
-    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
+    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string; ACell: PCell); override;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
     procedure WriteStyle(AStream: TStream);
     procedure WriteWindow1(AStream: TStream);
     procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean);
-    procedure WriteXF(AStream: TStream; AFontIndex: Word; AXF_TYPE_PROT: Byte);
+    procedure WriteXF(AStream: TStream; AFontIndex: Word;
+      AXF_TYPE_PROT, ATextRotation: Byte);
   end;
 
 implementation
@@ -223,6 +224,12 @@ const
   MASK_XF_VERT_ALIGN_BOTTOM           = $20;
   MASK_XF_VERT_ALIGN_JUSTIFIED        = $30;
 
+  { XF_ROTATION }
+
+  XF_ROTATION_HORIZONTAL                 = 0;
+  XF_ROTATION_90_DEGREE_COUNTERCLOCKWISE = 90;
+  XF_ROTATION_90_DEGREE_CLOCKWISE        = 180;
+
   { XF record constants }
   MASK_XF_TYPE_PROT                   = $0007;
   MASK_XF_TYPE_PROT_PARENT            = $FFF0;
@@ -314,37 +321,37 @@ begin
   end;
   
   // XF0
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF1
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF2
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF3
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF4
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF5
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF6
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF7
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF8
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF9
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF10
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF11
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF12
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL);
   // XF13
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_90_DEGREE_COUNTERCLOCKWISE);
   // XF14
-  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF);
+  WriteXF(AStream, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_90_DEGREE_CLOCKWISE);
   // XF15
-  WriteXF(AStream, 0, 0);
+  WriteXF(AStream, 0, 0, XF_ROTATION_HORIZONTAL);
 
   WriteStyle(AStream);
 
@@ -696,7 +703,7 @@ end;
 *
 *******************************************************************}
 procedure TsSpreadBIFF8Writer.WriteLabel(AStream: TStream; const ARow,
-  ACol: Word; const AValue: string);
+  ACol: Word; const AValue: string; ACell: PCell);
 var
   L: Word;
   WideValue: WideString;
@@ -721,8 +728,18 @@ begin
   AStream.WriteWord(WordToLE(ARow));
   AStream.WriteWord(WordToLE(ACol));
 
-  { Index to XF record }
+  { Index to XF record, according to formatting }
-  AStream.WriteWord(WordToLE(15));
+  if ACell^.UsedFormattingFields = [uffTextRotation] then
+  begin
+    case ACell^.TextRotation of
+      rt90DegreeCounterClockwiseRotation: AStream.WriteWord(WordToLE(13));
+      rt90DegreeClockwiseRotation: AStream.WriteWord(WordToLE(14));
+    else
+      AStream.WriteWord(WordToLE(15));
+    end;
+  end
+  else
+    AStream.WriteWord(WordToLE(15));
 
   { Byte String with 16-bit size }
   AStream.WriteWord(WordToLE(L));
@@ -898,7 +915,7 @@ end;
 *
 *******************************************************************}
 procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream; AFontIndex: Word;
- AXF_TYPE_PROT: Byte);
+ AXF_TYPE_PROT, ATextRotation: Byte);
 var
   XFOptions: Word;
   XFAlignment, XFOrientationAttrib: Byte;
@@ -927,7 +944,7 @@ begin
   AStream.WriteByte(XFAlignment);
 
   { Text rotation }
-  AStream.WriteByte(0);
+  AStream.WriteByte(ATextRotation); // 0 is horizontal / normal
 
   { Indentation, shrink and text direction }
   AStream.WriteByte(0);

components/fpspreadsheet/xlsxooxml.pas

@@ -63,7 +63,7 @@ type
       const AOverwriteExisting: Boolean = False); override;
     procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
     { Record writing methods }
-    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
+    procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string; ACell: PCell); override;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
   end;
 
@@ -382,7 +382,7 @@ end;
   Writes a string to the sheet
 }
 procedure TsSpreadOOXMLWriter.WriteLabel(AStream: TStream; const ARow,
-  ACol: Word; const AValue: string);
+  ACol: Word; const AValue: string; ACell: PCell);
 begin
 
 end;