pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Adds excel 8 writting example and starts implementing formatting

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1264 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2010-07-30 06:44:53 +00:00
parent 993fb896a3
commit 1389a835d1
11 changed files with 3322 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/excel5demo/excel5write.lpi
View File

@ -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"/>

26
components/fpspreadsheet/examples/excel5demo/excel5write.lpr
View File

@ -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
MyWorksheet.WriteUTF8Text(0, 0, 'First');
MyWorksheet.WriteUTF8Text(0, 1, 'Second');
MyWorksheet.WriteUTF8Text(0, 2, 'Third');
MyWorksheet.WriteUTF8Text(0, 3, 'Fourth');}
// 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);
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test.xls', sfExcel5, False);

56
components/fpspreadsheet/examples/excel8demo/excel8write.lpi Normal file
View File

@ -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>

90
components/fpspreadsheet/examples/excel8demo/excel8write.lpr Normal file
View File

@ -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.

2983
components/fpspreadsheet/fpsconvencoding.pas
View File

File diff suppressed because it is too large Load Diff

4
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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 +

67
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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,7 +83,21 @@ 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
@ -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
to the unicode encoding that the format supports.
On formats that don't support unicode, the text will be converted
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;

4
components/fpspreadsheet/xlsbiff2.pas
View File

@ -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;

83
components/fpspreadsheet/xlsbiff5.pas
View File

@ -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?)

61
components/fpspreadsheet/xlsbiff8.pas
View File

@ -117,12 +117,13 @@ type
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,7 +728,17 @@ begin
AStream.WriteWord(WordToLE(ARow));
AStream.WriteWord(WordToLE(ACol));
{ Index to XF record }
{ Index to XF record, according to formatting }
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 }
@ -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);

4
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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;