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

fpspreadsheet: Add unit xlsEscher for writing Microsoft Office shapes needed for cell comments in BIFF8. Writing of comments not yet working. Lots of additions to BIFFExplorer.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3942 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-02-14 22:27:49 +00:00
parent 50a5126435
commit 8e7a3b741a
11 changed files with 1883 additions and 479 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpspreadsheet/examples/fpsctrls/main.lfm
View File

@ -37,6 +37,7 @@ object MainForm: TMainForm
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
MouseWheelOption = mwGrid
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goEditing, goThumbTracking, goDblClickAutoSize, goSmoothScroll, goHeaderHotTracking, goCellHints]
ParentFont = False
RowCount = 101

5
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -8735,9 +8735,12 @@ end;
{@@ ----------------------------------------------------------------------------
(Pseudo-) abstract method writing a cell comment to the stream.
The cell comment is written immediately after the cell content.
NOTE: This is not good for XLSX and BIFF8.
Must be overridden by descendents.
@param ACell Pointer to the cell to be written
@param ACell Pointer to the cell containing the comment to be written
-------------------------------------------------------------------------------}
procedure TsCustomSpreadWriter.WriteComment(AStream: TStream; ACell: PCell);
begin

6
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -28,7 +28,7 @@
This package is all you need if you don't want graphical components (like grids and charts)."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="5"/>
<Files Count="29">
<Files Count="30">
<Item1>
<Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/>
@ -145,6 +145,10 @@ This package is all you need if you don't want graphical components (like grids
<Filename Value="fpstypes.pas"/>
<UnitName Value="fpsTypes"/>
</Item29>
<Item30>
<Filename Value="xlsescher.pas"/>
<UnitName Value="xlsEscher"/>
</Item30>
</Files>
<RequiredPkgs Count="2">
<Item1>

2
components/fpspreadsheet/laz_fpspreadsheet.pas
View File

@ -12,7 +12,7 @@ uses
fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole,
uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream,
fpolebasic, wikitable, fpsNumFormatParser, fpsfunc, fpsRPN, fpsStrings,
fpscsv, fpsCsvDocument, fpspatches, fpsTypes;
fpscsv, fpsCsvDocument, fpspatches, fpsTypes, xlsEscher;
implementation

1085
components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas
View File

File diff suppressed because it is too large Load Diff

6
components/fpspreadsheet/reference/BIFFExplorer/bebiffutils.pas
View File

@ -191,7 +191,7 @@ begin
$0006: Result := 'FORMULA';
$0007: Result := 'STRING';
$0008: Result := 'ROW';
$0009: Result := 'BOF';
$0009: Result := 'BOF: Begin of file';
$000A: Result := 'EOF: End of file';
$000B: Result := 'INDEX';
$000C: Result := 'CALCCOUNT: Iteration count';
@ -234,7 +234,7 @@ begin
$0037: Result := 'DateTable2';
$003C: Result := 'CONTINUE: Continues long records';
$003D: Result := 'WINDOW1: Window information';
$003E: Result := 'WINDOW2';
$003E: Result := 'WINDOW2: Window information';
$0040: Result := 'BACKUP: Save backup version of the file';
$0041: Result := 'PANE: Number of panes and their position';
$0042: Result := 'CODEPAGE: Default code page'; // also: CODENAME: VBE object name ???
@ -250,7 +250,7 @@ begin
$005A: Result := 'CRN: Non-resident operands';
$005B: Result := 'FILESHARING: File-sharing information';
$005C: Result := 'WRITEACCESS: Write access user name';
$005D: Result := 'OBJ';
$005D: Result := 'OBJ: Properties of an object in a sheet';
$005E: Result := 'UNCALCED: Recalculation status';
$005F: Result := 'SAVERECALC: Recalculate before saving';
$0060: Result := 'TEMPLATE: Workbook is a template';

84
components/fpspreadsheet/reference/BIFFExplorer/bemain.lfm
View File

@ -71,9 +71,9 @@ object MainForm: TMainForm
Height = 506
Top = 0
Width = 665
ActivePage = PgAnalysis
ActivePage = PgValues
Align = alClient
TabIndex = 0
TabIndex = 1
TabOrder = 0
OnChange = PageControlChange
object PgAnalysis: TTabSheet
@ -108,12 +108,12 @@ object MainForm: TMainForm
end
object PgValues: TTabSheet
Caption = 'Values'
ClientHeight = 463
ClientHeight = 478
ClientWidth = 657
object ValueGrid: TStringGrid
Left = 0
Height = 158
Top = 305
Top = 320
Width = 657
Align = alBottom
ColCount = 3
@ -144,17 +144,17 @@ object MainForm: TMainForm
end
object HexPanel: TPanel
Left = 0
Height = 300
Height = 315
Top = 0
Width = 657
Align = alClient
Caption = 'HexPanel'
ClientHeight = 300
ClientHeight = 315
ClientWidth = 657
TabOrder = 1
object HexGrid: TStringGrid
Left = 1
Height = 298
Height = 313
Top = 1
Width = 373
Align = alClient
@ -171,22 +171,22 @@ object MainForm: TMainForm
OnSelection = HexGridSelection
ColWidths = (
28
20
20
20
20
20
20
20
20
20
20
20
20
20
20
20
24
21
21
21
21
21
21
21
21
21
21
21
21
21
21
21
26
)
Cells = (
16
@ -242,7 +242,7 @@ object MainForm: TMainForm
end
object AlphaGrid: TStringGrid
Left = 379
Height = 298
Height = 313
Top = 1
Width = 277
Align = alRight
@ -256,22 +256,22 @@ object MainForm: TMainForm
OnClick = GridClick
OnSelection = AlphaGridSelection
ColWidths = (
16
16
16
16
16
16
16
16
16
16
16
16
16
16
16
16
17
17
17
17
17
17
17
17
17
17
17
17
17
17
17
18
)
Cells = (
16
@ -327,7 +327,7 @@ object MainForm: TMainForm
end
object HexDumpSplitter: TSplitter
Left = 374
Height = 298
Height = 313
Top = 1
Width = 5
Align = alRight
@ -338,7 +338,7 @@ object MainForm: TMainForm
Cursor = crVSplit
Left = 0
Height = 5
Top = 300
Top = 315
Width = 657
Align = alBottom
ResizeAnchor = akBottom

10
components/fpspreadsheet/reference/BIFFExplorer/bemain.pas
View File

@ -769,22 +769,24 @@ procedure TMainForm.LoadFile(const AFileName: String);
var
valid: Boolean;
excptn: Exception = nil;
ext: String;
begin
if not FileExistsUTF8(AFileName) then begin
MessageDlg(Format('File "%s" not found.', [AFileName]), mtError, [mbOK], 0);
exit;
end;
if Lowercase(ExtractFileExt(AFileName)) <> '.xls' then begin
ext := Lowercase(ExtractFileExt(AFilename));
if ext <> '.xls' then begin
MessageDlg('BIFFExplorer can only process binary Excel files (extension ".xls")',
mtError, [mbOK], 0);
exit;
end;
// .xls files can contain several formats. We look into the header first.
if Lowercase(ExtractFileExt(AFileName))=STR_EXCEL_EXTENSION then
if ext = STR_EXCEL_EXTENSION then
begin
valid := GetFormatFromFileHeader(AFileName, FFormat);
valid := GetFormatFromFileHeader(UTF8ToAnsi(AFileName), FFormat);
// It is possible that valid xls files are not detected correctly. Therefore,
// we open them explicitly by trial and error - see below.
if not valid then
@ -853,7 +855,7 @@ begin
// Rewind the stream and read from it
MemStream.Position := 0;
FFileName := ExpandFileName(UTF8ToSys(AFileName));
FFileName := ExpandFileName(AFileName);
ReadFromStream(MemStream);
FFormat := AFormat;

539
components/fpspreadsheet/xlsbiff8.pas
View File

@ -117,10 +117,16 @@ type
{ TsSpreadBIFF8Writer }
TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter)
private
FCommentList: TFPList;
procedure WriteCommentsCallback(ACell: PCell; AStream: TStream);
protected
{ Record writing methods }
procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64;
procedure WriteComment(AStream: TStream; ACell: PCell); override;
procedure WriteComments(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont);
@ -129,8 +135,14 @@ type
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteMSODrawing1(AStream: TStream; ANumShapes: Word; ACell: PCell);
procedure WriteMSODrawing2(AStream: TStream; ACell: PCell; AObjID: Word);
procedure WriteMSODrawing2_Data(AStream: TStream; ACell: PCell; AShapeID: Word);
procedure WriteMSODrawing3(AStream: TStream; ACell: PCell);
procedure WriteNOTE(AStream: TStream; ACell: PCell; AObjID: Word);
procedure WriteNumFormat(AStream: TStream; AFormatData: TsNumFormatData;
AListIndex: Integer); override;
procedure WriteOBJ(AStream: TStream; AObjID: Word);
function WriteRPNCellAddress(AStream: TStream; ARow, ACol: Cardinal;
AFlags: TsRelFlags): word; override;
function WriteRPNCellOffset(AStream: TStream; ARowOffset, AColOffset: Integer;
@ -139,8 +151,9 @@ type
AFlags: TsRelFlags): Word; override;
function WriteString_8bitLen(AStream: TStream; AString: String): Integer; override;
procedure WriteStringRecord(AStream: TStream; AString: string); override;
procedure WriteStyle(AStream: TStream);
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
procedure WriteSTYLE(AStream: TStream);
procedure WriteTXO(AStream: TStream; ACell: PCell);
procedure WriteWINDOW2(AStream: TStream; ASheet: TsWorksheet);
procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat;
XFType_Prot: Byte = 0); override;
public
@ -227,11 +240,13 @@ var
implementation
uses
Math, lconvencoding, fpsStrings, fpsStreams, fpsExprParser;
Math, lconvencoding,
fpsStrings, fpsStreams, fpsExprParser, xlsEscher;
const
{ Excel record IDs }
INT_EXCEL_ID_MERGEDCELLS = $00E5; // BIFF8 only
INT_EXCEL_ID_MSODRAWING = $00EC; // BIFF8 only
INT_EXCEL_ID_SST = $00FC; // BIFF8 only
INT_EXCEL_ID_LABELSST = $00FD; // BIFF8 only
INT_EXCEL_ID_TXO = $01B6; // BIFF8 only
@ -312,6 +327,8 @@ const
XF_ROTATION_STACKED
);
SHAPEID_BASE = 1024;
type
TBIFF8_DimensionsRecord = packed record
RecordID: Word;
@ -357,11 +374,26 @@ type
BkGr3: Word;
end;
TBIFF8TXORecord = packed record
RecordID: Word;
RecordSize: Word;
OptionFlags: Word;
TextRot: Word;
Reserved1: Word;
Reserved2: Word;
Reserved3: Word;
TextLen: Word;
NumFormattingRuns: Word;
Reserved4: Word;
Reserved5: Word;
end;
TBIFF8Comment = class
ID: Integer;
Text: String;
end;
{ TsSpreadBIFF8Reader }
destructor TsSpreadBIFF8Reader.Destroy;
@ -1104,23 +1136,11 @@ end;
We only extract the length of the comment text (in characters). The text itself
is contained in the following CONTINUE record. }
procedure TsSpreadBIFF8Reader.ReadTXO(const AStream: TStream);
type
TBIFF8TXORecord = packed record
OptionFlags: Word;
TextRot: Word;
Reserved1: Word;
Reserved2: Word;
Reserved3: Word;
TextLen: Word;
NumFormattingRuns: Word;
Reserved4: Word;
Reserved5: Word;
end;
var
rec: TBIFF8TXORecord;
begin
rec.OptionFlags := 0; // to silence the compiler
AStream.ReadBuffer(rec, Sizeof(Rec));
AStream.ReadBuffer(rec.OptionFlags, Sizeof(Rec) - 2*SizeOf(Word));
FCommentLen := WordLEToN(rec.TextLen);
end;
@ -1462,6 +1482,7 @@ begin
else begin
WriteRows(AStream, FWorksheet);
WriteCellsToStream(AStream, FWorksheet.Cells);
WriteComments(AStream, FWorksheet);
end;
// View settings block
@ -1490,8 +1511,7 @@ end;
procedure TsSpreadBIFF8Writer.WriteBOF(AStream: TStream; ADataType: Word);
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOF));
AStream.WriteWord(WordToLE(16)); //total record size
WriteBIFFHeader(AStream, INT_EXCEL_ID_BOF, 16);
{ BIFF version. Should only be used if this BOF is for the workbook globals }
{ OpenOffice rejects to correctly read xls files if this field is
@ -1515,19 +1535,14 @@ begin
AStream.WriteDWord(DWordToLE(0)); //?????????
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteBoundsheet ()
*
* DESCRIPTION: Writes an Excel 8 BOUNDSHEET record
*
* Always located on the workbook globals substream.
*
* One BOUNDSHEET is written for each worksheet.
*
* RETURNS: The stream position where the absolute stream position
* of the BOF of this sheet should be written (4 bytes size).
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 BOUNDSHEET record
Always located in the workbook globals substream.
One BOUNDSHEET is written for each worksheet.
@return The stream position where the absolute stream position
of the BOF of this sheet should be written (4 bytes size).
-------------------------------------------------------------------------------}
function TsSpreadBIFF8Writer.WriteBoundsheet(AStream: TStream; ASheetName: string): Int64;
var
Len: Byte;
@ -1537,8 +1552,7 @@ begin
Len := Length(WideSheetName);
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOUNDSHEET));
AStream.WriteWord(WordToLE(6 + 1 + 1 + Len * Sizeof(WideChar)));
WriteBIFFHeader(AStream, INT_EXCEL_ID_BOUNDSHEET, 8 + Len * Sizeof(WideChar));
{ Absolute stream position of the BOF record of the sheet represented
by this record }
@ -1558,6 +1572,63 @@ begin
AStream.WriteBuffer(WideStringToLE(WideSheetName)[1], Len * Sizeof(WideChar));
end;
{@@ ----------------------------------------------------------------------------
Inherited method for writing a cell comment immediately after cell content.
A writing method has been implemented by xlscommon. But in BIFF8, this
must not do anything because comments are collected in a list and
written en-bloc. See WriteComments.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteComment(AStream: TStream; ACell: PCell);
begin
// Nothing to do. Reverts the behavior introduced by xlscommon.
Unused(AStream, ACell);
end;
{@@ ----------------------------------------------------------------------------
Writes all comments to the worksheet stream
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteComments(AStream: TStream;
AWorksheet: TsWorksheet);
var
i: Integer;
begin
exit; // Remove after comments can be written correctly
{$warning TODO: Fix writing of cell comments in BIFF8 (file is readable by OpenOffice, but not by Excel)}
FCommentList := TFPList.Create;
try
IterateThroughCells(AStream, AWorksheet.Cells, WriteCommentsCallback);
if FCommentList.Count = 0 then
exit;
for i:=0 to FCommentList.Count-1 do begin
if i = 0 then
WriteMSODRAWING1(AStream, FCommentList.Count, PCell(FCommentList[i]))
else
WriteMSODRAWING2(AStream, PCell(FCommentList[i]), i+1);
WriteOBJ(AStream, i+1);
WriteMSODRAWING3(AStream, PCell(FCommentList[i]));
WriteTXO(AStream, PCell(FCommentList[i]));
end;
for i:=0 to FCommentList.Count-1 do
WriteNOTE(AStream, PCell(FCommentList[i]), i+1);
finally
FreeAndNil(FCommentList);
end;
end;
{@@ ----------------------------------------------------------------------------
Helper method which stores the pointer to a cell in the FCommentsList if the
cell contains a comment
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteCommentsCallback(ACell: PCell;
AStream: TStream);
begin
Unused(AStream);
if (ACell <> nil) and (ACell^.Comment <> '') then
FCommentList.Add(ACell);
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 DIMENSIONS record
@ -1590,29 +1661,20 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteEOF ()
*
* DESCRIPTION: Writes an Excel 8 EOF record
*
* This must be the last record on an Excel 8 stream
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 EOF record.
This must be the last record on an Excel 8 stream
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteEOF(AStream: TStream);
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_EOF));
AStream.WriteWord(WordToLE($0000));
WriteBIFFHeader(AStream, INT_EXCEL_ID_EOF, 0);
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteFont ()
*
* DESCRIPTION: Writes an Excel 8 FONT record
*
* The font data is passed in an instance of TsFont
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 FONT record.
The font data is passed as an instance of TsFont
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteFont(AStream: TStream; AFont: TsFont);
var
Len: Byte;
@ -1631,8 +1693,7 @@ begin
Len := Length(WideFontName);
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FONT));
AStream.WriteWord(WordToLE(14 + 1 + 1 + Len * Sizeof(WideChar)));
WriteBIFFHeader(AStream, INT_EXCEL_ID_FONT, 16 + Len * Sizeof(WideChar));
{ Height of the font in twips = 1/20 of a point }
AStream.WriteWord(WordToLE(round(AFont.Size*20)));
@ -1691,7 +1752,179 @@ var
i: Integer;
begin
for i:=0 to Workbook.GetFontCount-1 do
WriteFont(AStream, Workbook.GetFont(i));
WriteFONT(AStream, Workbook.GetFont(i));
end;
{@@ ----------------------------------------------------------------------------
Writes the first MSODRAWING record to file. It is needed for a comment
attached to a cell, but also for embedded shapes (currently not supported).
<pre>
Structure of this record:
Type Ver Inst
Dg container $F002 0
|--- FDG record $F008 0 1
|--- SpGr container $F003 0
|---- Sp container (group shape) $F004 0
| |---- FSpGr record $F009 1 0
MSODRAWING1 | |---- FSp record $F00A 2 0
................................................................................
MSODRAWING2 |---- Sp container (child shape) $F004 0
|---- FSp record $F00A 2 202 (Textbox)
|---- FOpt record $F00B 3 13 (num props)
|---- Client anchor record $F010 0 0
|---- Client data record $F011 0 0
</pre>
-------------------------------------------------------------------------------}
procedure TsSpreadBiff8Writer.WriteMSODrawing1(AStream: TStream; ANumShapes: Word;
ACell: PCell);
const
DRAWING_ID = 1;
var
len: DWord;
tmpStream: TMemoryStream;
begin
tmpStream := TMemoryStream.Create;
try
{ OfficeArtDgContainer record (container of drawing) }
len := 224 + 152*(ANumShapes - 1);
WriteMSODgContainer(tmpStream, len);
{ OfficeArtFdg record (info on shapes: num shapes, drawing ID, last Obj ID ) }
WriteMSOFdgRecord(tmpStream, ANumShapes + 1, DRAWING_ID, SHAPEID_BASE + ANumShapes);
{ OfficeArtSpGrContainer record (shape group container) }
len := 200 + 152*(ANumShapes - 1);
WriteMSOSpGrContainer(tmpStream, len);
{ OfficeArtSpContainer record }
WriteMSOSpContainer(tmpStream, 40);
{ OfficeArtFSpGr record }
WriteMSOFSpGrRecord(tmpStream, 0, 0, 0, 0); // 16 + 8 bytes
{ OfficeArtFSp record }
WriteMSOFSpRecord(tmpStream, SHAPEID_BASE, MSO_SPT_NOTPRIMITIVE,
MSO_FSP_BITS_GROUP + MSO_FSP_BITS_PATRIARCH); // 8 + 8 bytes
{ Data for the 1st comment }
WriteMSODrawing2_Data(tmpStream, ACell, SHAPEID_BASE + 1);
// Write the BIFF stream
tmpStream.Position := 0;
len := tmpStream.Size;
WriteBiffHeader(AStream, INT_EXCEL_ID_MSODRAWING, tmpStream.Size);
AStream.CopyFrom(tmpStream, tmpStream.Size);
finally
tmpStream.Free;
end;
end;
{ Write the MSODRAWING record which occurs before the OBJ record.
Do not use for the very first OBJ record where the record must be
WriteMSODrawing1 + WriteMSODrawing2_Data + WriteMSODrawing3_Data}
procedure TsSpreadBiff8Writer.WriteMSODrawing2(AStream: TStream; ACell: PCell;
AObjID: Word);
var
tmpStream: TStream;
len: Word;
begin
tmpStream := TMemoryStream.Create;
try
{ Shape data for cell comment }
WriteMSODrawing2_Data(tmpStream, ACell, SHAPEID_BASE + AObjID);
{ Get size of data stream }
len := tmpStream.Size;
{ BIFF Header }
WriteBiffHeader(AStream, INT_EXCEL_ID_MSODRAWING, len);
{ Copy MSO data to BIFF stream }
tmpStream.Position := 0;
AStream.CopyFrom(tmpStream, len);
finally
tmpStream.Free;
end;
end;
procedure TsSpreadBiff8Writer.WriteMSODrawing2_Data(AStream: TStream;
ACell: PCell; AShapeID: Word);
var
tmpStream: TStream;
len: Cardinal;
begin
// We write all the record data to a temporary stream to get the record
// size (it depends on the number of properties written to the FOPT record.
// The record size is needed in the very first SpContainer record...
tmpStream := TMemoryStream.Create;
try
{ OfficeArtFSp record }
WriteMSOFSpRecord(tmpStream, AShapeID, MSO_SPT_TEXTBOX,
MSO_FSP_BITS_HASANCHOR + MSO_FSP_BITS_HASSHAPETYPE);
{ OfficeArtFOpt record }
WriteMSOFOptRecord_Comment(tmpStream);
{ OfficeArtClientAnchor record }
WriteMSOClientAnchorSheetRecord(tmpStream,
ACell^.Row + 1, ACell^.Col + 1, ACell.Row + 3, ACell^.Col + 5,
691, 486, 38, 26,
true, true
);
{ OfficeArtClientData record }
WriteMSOClientDataRecord(tmpStream);
// Now we know the record size
len := tmpStream.Size;
// Write an OfficeArtSpContainer to the stream provided...
WriteMSOSpContainer(AStream, len+8); // !!! for some reason, Excel wants here 8 additional bytes !!!
// ... and append the data from the temporary stream.
tmpStream.Position := 0;
AStream.Copyfrom(tmpStream, len);
finally
tmpStream.Free;
end;
end;
{ Writes the MSODRAWING record which must occur immediately before a TXO record }
procedure TsSpreadBiff8Writer.WriteMSODRAWING3(AStream: TStream; ACell: PCell);
begin
{ BIFF Header }
WriteBiffHeader(AStream, INT_EXCEL_ID_MSODRAWING, 8);
{ OfficeArtClientTextbox record: Text-related data for a shape }
WriteMSOClientTextBoxRecord(AStream);
end;
{ Writes a NOTE record for a comment attached to a cell }
procedure TsSpreadBiff8Writer.WriteNOTE(AStream: TStream; ACell: PCell;
AObjID: Word);
const
AUTHOR: ansistring = 'Werner';
var
len: Integer;
begin
len := Length(AUTHOR) * sizeOf(ansichar);
{ BIFF Header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_NOTE)); // ID of NOTE record
AStream.WriteWord(WordToLE(12+len)); // Size of NOTE record
{ Record data }
AStream.WriteWord(WordToLE(ACell^.Row)); // Row index of cell
AStream.WriteWord(WordToLE(ACell^.Col)); // Column index of cell
AStream.WriteWord(0); // Flags
AStream.WriteWord(WordToLE(AObjID)); // Object identifier (1, ...)
AStream.WriteWord(len); // Char length of author string
AStream.WriteByte(0); // Flag for 8-bit characters
AStream.WriteBuffer(AUTHOR[1], len); // Author
AStream.WriteByte(0); // Unused
end;
procedure TsSpreadBiff8Writer.WriteNumFormat(AStream: TStream;
@ -1742,6 +1975,35 @@ begin
SetLength(buf, 0);
end;
{ Writes an OBJ record - belongs to the record required for cell comments }
procedure TsSpreadBIFF8Writer.WriteOBJ(AStream: TStream; AObjID: Word);
var
guid: TGuid;
begin
AStream.WriteWord(WordToLE(INT_EXCEL_ID_OBJ));
AStream.WriteWord(WordToLE(52));
AStream.WriteWord(WordToLE($0015)); // Subrecord ftCmo
AStream.WriteWord(WordToLE(18)); // Subrecord size: 18 bytes
AStream.WriteWord(WordToLE($0019)); // Object type: Comment
AStream.WriteWord(WordToLE(AObjID)); // Object ID number (1, ... )
AStream.WriteWord(WordToLE($4011)); // Option flags automatic line style, locked when sheet is protected
AStream.WriteDWord(0); // Unused
AStream.WriteDWord(0); // Unused
AStream.WriteDWord(0); // Unused
AStream.WriteWord(WordToLE($000D)); // Subrecord ftNts
AStream.WriteWord(WordToLE(22)); // Size of subrecord: 22 bytes
// CreateGUID(guid);
FillChar(guid{%H-}, SizeOf(guid), 0);
AStream.WriteBuffer(guid, 16); // GUID of comment
AStream.WriteWord(WordToLE(0)); // shared note (0 = false)
AStream.WriteDWord(0); // unused
AStream.WriteWord(WordToLE($0000)); // Subrecord ftEnd
AStream.WriteWord(0); // Size of subrecord: 0 bytes
end;
{ Writes the address of a cell as used in an RPN formula and returns the
number of bytes written. }
function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream;
@ -1840,19 +2102,15 @@ begin
AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar));
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteIndex ()
*
* DESCRIPTION: Writes an Excel 8 INDEX record
*
* nm = (rl - rf - 1) / 32 + 1 (using integer division)
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 INDEX record
nm = (rl - rf - 1) / 32 + 1 (using integer division)
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteIndex(AStream: TStream);
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_INDEX));
AStream.WriteWord(WordToLE(16));
WriteBIFFHeader(AStream, INT_EXCEL_ID_INDEX, 16);
{ Not used }
AStream.WriteDWord(DWordToLE(0));
@ -1872,16 +2130,12 @@ begin
{ OBS: It seems to be no problem just ignoring this part of the record }
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteLabel ()
*
* DESCRIPTION: Writes an Excel 8 LABEL record
*
* Writes a string to the sheet
* If the string length exceeds 32758 bytes, the string
* will be silently truncated.
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 LABEL record (string cell value)
If the string length exceeds 32758 bytes, the string will be truncated,
a note will be left in the workbooks log.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteLabel(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: string; ACell: PCell);
const
@ -1963,8 +2217,7 @@ begin
// at most 1026 merged ranges per BIFF record, the rest goes into a new record
{ BIFF record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_MERGEDCELLS));
AStream.WriteWord(WordToLE(2 + n*8));
WriteBIFFHeader(AStream, INT_EXCEL_ID_MERGEDCELLS, 2 + n*8);
// Count of cell ranges in this record
AStream.WriteWord(WordToLE(n));
@ -1983,20 +2236,16 @@ begin
end;
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteStyle ()
*
* DESCRIPTION: Writes an Excel 8 STYLE record
*
* Registers the name of a user-defined style or
* specific options for a built-in cell style.
*
*******************************************************************}
{@@-----------------------------------------------------------------------------
Writes an Excel 8 STYLE record
Registers the name of a user-defined style or specific options
for a built-in cell style.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteStyle(AStream: TStream);
begin
{ BIFF record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_STYLE));
AStream.WriteWord(WordToLE(4));
WriteBiffHeader(AStream, INT_EXCEL_ID_STYLE, 4);
{ Index to style XF and defines if it's a built-in or used defined style }
AStream.WriteWord(WordToLE(MASK_STYLE_BUILT_IN));
@ -2008,27 +2257,83 @@ begin
AStream.WriteByte($FF);
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteWindow2 ()
*
* DESCRIPTION: Writes an Excel 8 WINDOW2 record
*
* This record contains aditional settings for the
* document window (BIFF2-BIFF4) or for a specific
* worksheet (BIFF5-BIFF8).
*
* The values written here are reasonable defaults,
* which should work for most sheets.
*
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteWindow2(AStream: TStream;
ASheet: TsWorksheet);
{@@ ----------------------------------------------------------------------------
Writes a TXO and two CONTINUE records as needed for cell comments.
It can safely be assumed that the cell exists and contains a comment.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteTXO(AStream: TStream; ACell: PCell);
var
recTXO: TBIFF8TXORecord;
comment: widestring;
compressed: ansistring;
len: Integer;
wchar: widechar;
i: Integer;
bytesFmtRuns: Integer;
begin
{ Prepare comment string. It is stored as a string with 8-bit characters }
comment := UTF8Decode(ACell^.Comment);
SetLength(compressed, length(comment));
for i:= 1 to Length(comment) do
begin
wchar := comment[i];
compressed[i] := wchar;
end;
len := Length(compressed);
{ (1) TXO record ---------------------------------------------------------- }
{ BIFF record header }
FillChar(recTXO{%H-}, SizeOf(recTXO), 0);
recTXO.RecordID := WordToLE(INT_EXCEL_ID_TXO);
recTXO.RecordSize := SizeOf(recTXO) - 2*SizeOf(word);
{ Record data }
recTXO.OptionFlags := WordToLE($0212); // Left & top aligned, lock option on
recTXO.TextRot := 0; // Comment text not rotated
recTXO.TextLen := WordToLE(len);
bytesFmtRuns := 8*SizeOf(Word); // see (3) below
recTXO.NumFormattingRuns := WordToLE(bytesFmtRuns);
{ Write out to file }
AStream.WriteBuffer(recTXO, SizeOf(recTXO));
{ (2) 1st CONTINUE record containing the comment text --------------------- }
{ BIFF record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_CONTINUE));
AStream.WriteWord(len+1);
{ Record data }
AStream.WriteByte(0);
AStream.WriteBuffer(compressed[1], len);
{ (3) 2nd CONTINUE record containing the formatting runs ------------------ }
{ BIFF record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_CONTINUE));
AStream.WriteWord(bytesFmtRuns);
{ Record data }
AStream.WriteWord(0); // start index of 1st formatting run (we only use 1 run)
AStream.WriteWord(WordToLE(1)); // Font index to be used (default font)
AStream.WriteWord(0); // Not used
AStream.WriteWord(0); // Not used
AStream.WriteWord(WordToLE(len)); // lastRun: number of characters
AStream.WriteWord(0); // Not used
AStream.WriteWord(0); // Not used
AStream.WriteWord(0); // Not used
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 WINDOW2 record
This record contains additional settings for the document window (BIFF2-BIFF4)
or for a specific worksheet (BIFF5-BIFF8).
The values written here are reasonable defaults, which should work for most
sheets.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteWINDOW2(AStream: TStream;
ASheet: TsWorksheet);
var
Options: Word;
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_WINDOW2));
AStream.WriteWord(WordToLE(18));
WriteBiffHeader(AStream, INT_EXCEL_ID_WINDOW2, 18);
{ Options flags }
Options :=
@ -2069,14 +2374,9 @@ begin
AStream.WriteDWord(DWordToLE(0));
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteXF ()
*
* DESCRIPTION: Writes an Excel 8 XF record
*
*
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 XF record (cell format)
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream;
AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0);
var
@ -2087,7 +2387,7 @@ var
begin
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_XF);
rec.RecordSize := WordToLE(SizeOf(TBIFF8_XFRecord) - 2*SizeOf(Word));
rec.RecordSize := WordToLE(SizeOf(TBIFF8_XFRecord) - SizeOf(TsBIFFHeader));
{ Index to font record }
rec.FontIndex := 0;
@ -2216,13 +2516,12 @@ begin
end;
{*******************************************************************
* Initialization section
*
* Registers this reader / writer on fpSpreadsheet
* Converts the palette to litte-endian
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Initialization section
Registers this reader / writer on fpSpreadsheet
Converts the palette to litte-endian
-------------------------------------------------------------------------------}
initialization

62
components/fpspreadsheet/xlscommon.pas
View File

@ -204,6 +204,12 @@ type
function ConvertToExcelError(AValue: TsErrorValue): byte;
type
{ TsBIFFHeader }
TsBIFFHeader = packed record
RecordID: Word;
RecordSize: Word;
end;
{ TsBIFFNumFormatList }
TsBIFFNumFormatList = class(TsCustomNumFormatList)
protected
@ -311,6 +317,9 @@ type
function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
procedure GetLastColCallback(ACell: PCell; AStream: TStream);
function GetLastColIndex(AWorksheet: TsWorksheet): Word;
// Helper function for writing the BIFF header
procedure WriteBIFFHeader(AStream: TStream; ARecID, ARecSize: Word);
// Helper function for writing a string with 8-bit length }
function WriteString_8BitLen(AStream: TStream; AString: String): Integer; virtual;
@ -1817,6 +1826,24 @@ begin
Result := FLastCol;
end;
{@@ ----------------------------------------------------------------------------
Writes the BIFF record header consisting of the record ID and the size of
data to be written immediately afterwards.
@param ARecID ID of the record - see the INT_EXCEL_ID_XXXX constants
@param ARedSize Size (in bytes) of the data which follow immediately
afterwards
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.WriteBIFFHeader(AStream: TStream;
ARecID, ARecSize: Word);
var
rec: TsBIFFHeader;
begin
rec.RecordID := WordToLE(ARecID);
rec.RecordSize := WordToLE(ARecSize);
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{ Writes an empty ("blank") cell. Needed for formatting empty cells.
Valid for BIFF5 and BIFF8. Needs to be overridden for BIFF2 which has a
different record structure. }
@ -1844,7 +1871,7 @@ begin
end;
{ Writes a BOOLEAN cell record.
Valie for BIFF3-BIFF8. Override for BIFF2. }
Valid for BIFF3-BIFF8. Override for BIFF2. }
procedure TsSpreadBIFFWriter.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
@ -1883,8 +1910,7 @@ var
cp: Word;
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_CODEPAGE));
AStream.WriteWord(WordToLE(2));
WriteBIFFHeader(AStream, INT_EXCEL_ID_CODEPAGE, 2);
{ Codepage }
FCodePage := lowercase(ACodePage);
@ -2028,8 +2054,7 @@ procedure TsSpreadBIFFWriter.WriteDateMode(AStream: TStream);
begin
{ BIFF Record header }
// todo: check whether this is in the right place. should end up in workbook globals stream
AStream.WriteWord(WordToLE(INT_EXCEL_ID_DATEMODE));
AStream.WriteWord(WordToLE(2));
WriteBIFFHeader(AStream, INT_EXCEL_ID_DATEMODE, 2);
case FDateMode of
dm1900: AStream.WriteWord(WordToLE(0));
@ -2155,22 +2180,23 @@ begin
end;
procedure TsSpreadBIFFWriter.WritePalette(AStream: TStream);
const
NUM_COLORS = 56;
var
i, n: Integer;
rgb: TsColorValue;
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_PALETTE));
AStream.WriteWord(WordToLE(2 + 4*56));
WriteBIFFHeader(AStream, INT_EXCEL_ID_PALETTE, 2 + 4*NUM_COLORS);
{ Number of colors }
AStream.WriteWord(WordToLE(56));
AStream.WriteWord(WordToLE(NUM_COLORS));
{ Take the colors from the palette of the Worksheet }
n := Workbook.GetPaletteSize;
{ Skip the first 8 entries - they are hard-coded into Excel }
for i:=8 to 63 do
for i := 8 to 8 + NUM_COLORS - 1 do
begin
rgb := Math.IfThen(i < n, Workbook.GetPaletteColor(i), $FFFFFF);
AStream.WriteDWord(DWordToLE(rgb))
@ -2185,8 +2211,7 @@ var
dbl: Double;
begin
{ BIFF record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_PAGESETUP));
AStream.WriteWord(WordToLE(9*2 + 2*8));
WriteBIFFHeader(AStream, INT_EXCEL_ID_PAGESETUP, 9*2 + 2*8);
{ Paper size }
AStream.WriteWord(WordToLE(0)); // 1 = Letter, 9 = A4
@ -2242,9 +2267,8 @@ begin
error. They possibly require an additional SELECTION record. }
{ BIFF record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_PANE));
if isBIFF58 then n := 10 else n := 9;
AStream.WriteWord(WordToLE(n));
WriteBIFFHeader(AStream, INT_EXCEL_ID_PANE, n);
{ Position of the vertical split (px, 0 = No vertical split):
- Unfrozen pane: Width of the left pane(s) (in twips = 1/20 of a point)
@ -2706,8 +2730,7 @@ begin
end;
{ BIFF record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_ROW));
AStream.WriteWord(WordToLE(16));
WriteBIFFHeader(AStream, INT_EXCEL_ID_ROW, 16);;
{ Index of row }
AStream.WriteWord(WordToLE(Word(ARowIndex)));
@ -2792,8 +2815,7 @@ begin
end;
{ BIFF record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_SELECTION));
AStream.WriteWord(WordToLE(15));
WriteBIFFHeader(AStream, INT_EXCEL_ID_SELECTION, 15);
{ Pane identifier }
AStream.WriteByte(APane);
@ -2923,8 +2945,7 @@ var
flags: Word;
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_SHEETPR));
AStream.WriteWord(WordToLE(2));
WriteBIFFHeader(AStream, INT_EXCEL_ID_SHEETPR, 2);
flags := $04C1;
AStream.WriteWord(WordToLE(flags));
@ -3016,8 +3037,7 @@ end;
procedure TsSpreadBIFFWriter.WriteWindow1(AStream: TStream);
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_WINDOW1));
AStream.WriteWord(WordToLE(18));
WriteBIFFHeader(AStream, INT_EXCEL_ID_WINDOW1, 18);
{ Horizontal position of the document window, in twips = 1 / 20 of a point }
AStream.WriteWord(WordToLE(0));

562
components/fpspreadsheet/xlsescher.pas Normal file
View File

@ -0,0 +1,562 @@
{ xlsEscher }
{@@ ----------------------------------------------------------------------------
The unit xlsExcel provides basic support for the hierarchy of shapes and
drawings in Microsoft Office files ("Escher", "OfficeArt") as it is needed for
the BIFF record MSODRAWING (Cell comments, charts).
AUTHORS: Werner Pamler
DOCUMENTATION:
Office Drawing 97-2007 Binary Format Specification
http://www.digitalpreservation.gov/formats/digformatspecs/OfficeDrawing97-2007BinaryFormatSpecification.pdf
[MS-ODRAW].pdf
https://msdn.microsoft.com/en-us/library/office/cc441433%28v=office.12%29.aspx
[MS-PPT].pdf
https://msdn.microsoft.com/en-us/library/office/cc313106%28v=office.12%29.aspx
[MS-XLS].pdf
https://msdn.microsoft.com/en-us/library/office/cc313154%28v=office.12%29.aspx
LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus
distribution, for details about the license.
-------------------------------------------------------------------------------}
unit xlsEscher;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
const
{ Record IDs }
MSO_ID_OFFICEART_DG_CONTAINER = $F002;
MSO_ID_OFFICEART_SPGR_CONTAINER = $F003;
MSO_ID_OFFICEART_SP_CONTAINER = $F004;
MSO_ID_OFFICEART_FDG = $F008;
MSO_ID_OFFICEART_FSPGR = $F009;
MSO_ID_OFFICEART_FSP = $F00A;
MSO_ID_OFFICEART_FOPT = $F00B;
MSO_ID_OFFICEART_CLIENTTEXTBOX = $F00D;
MSO_ID_OFFICEART_CLIENTANCHORSHEET = $F010;
MSO_ID_OFFICEART_CLIENTDATA = $F011;
{ Record version }
MSO_VER_CONTAINER = $0F;
{ Shape types }
MSO_SPT_MIN = 0;
MSO_SPT_NOTPRIMITIVE = MSO_SPT_MIN;
MSO_SPT_RECTANGLE = 1;
MSO_SPT_ROUNDRECTANGLE = 2;
MSO_SPT_ELLIPSE = 3;
MSO_SPT_DIAMOND = 4;
MSO_SPT_ISOCELESTRIANGLE = 5;
MSO_SPT_RIGHT_TRIANGLE = 6;
MSO_SPT_PARALLELOGRAM = 7;
MSO_SPT_TRAPEZOID = 8;
MSO_SPT_HEXAGON = 9;
MSO_SPT_OCTAGON = 10;
MSO_SPT_PLUS = 11;
MSO_SPT_STAR = 12;
MSO_SPT_ARROW = 13;
MSO_SPT_THICKARROW = 14;
MSO_SPT_HOMEPLAT = 15;
MSO_SPT_CUBE = 16;
MSO_SPT_BALLOON = 17;
MSO_SPT_SEAL = 18;
MSO_SPT_ARC = 19;
MSO_SPT_LINE = 20;
MSO_SPT_PLAQUE = 21;
MSO_SPT_CAN = 22;
MSO_SPT_DONUT = 23;
MSO_SPT_TEXTSIMPLE = 24;
MSO_SPT_TEXTOCTAGON = 25;
MSO_SPT_TEXTHEXAGON = 26;
MSO_SPT_TEXTCURVE = 27;
MSO_SPT_TEXTWAVE = 28;
MSO_SPT_TEXTRING = 29;
MSO_SPT_TEXTONCURVE = 30;
MSO_SPT_TEXTONRING = 31;
MSO_SPT_STRAIGHTCONNECTOR1 = 32;
MSO_SPT_BENTCONNECTOR2 = 33;
MSO_SPT_BENTCONNECTOR3 = 34;
MSO_SPT_BENTCONNECTOR4 = 35;
MSO_SPT_BENTCONNECTOR5 = 36;
MSO_SPT_CURVEDCONNECTOR2 = 37;
MSO_SPT_CURVEDCONNECTOR3 = 38;
MSO_SPT_CURVEDCONNECTOR4 = 39;
MSO_SPT_CURVEDCONNECTOR5 = 40;
MSO_SPT_CALLOUT1 = 41;
MSO_SPT_CALLOUT2 = 42;
MSO_SPT_CALLOUT3 = 43;
MSO_SPT_ACCENTCALLOUT1 = 44;
MSO_SPT_ACCENTCALLOUT2 = 45;
MSO_SPT_ACCENTCALLOUT3 = 46;
MSO_SPT_BORDERCALLOUT1 = 47;
MSO_SPT_BORDERCALLOUT2 = 48;
MSO_SPT_BORDERCALLOUT3 = 49;
MSO_SPT_ACCENTBORDERCALLOUT1 = 50;
MSO_SPT_ACCENTBORDERCALLOUT2 = 51;
MSO_SPT_ACCENTBORDERCALLOUT3 = 52;
MSO_SPT_RIBBON = 53;
MSO_SPT_RIBBON2 = 54;
MSO_SPT_CHEVRON = 55;
MSO_SPT_PENTAGON = 56;
MSO_SPT_NOSMOKING = 57;
MSO_SPT_SEAL8 = 58;
MSO_SPT_SEAL16 = 59;
MSO_SPT_SEAL32 = 60;
MSO_SPT_WEDGERECTCALLOUT = 61;
MSO_SPT_WEDGERRECTCALLOUT = 62;
MSO_SPT_WEDGEELLIPSECALLOUT = 63;
MSO_SPT_WAVE = 64;
MSO_SPT_FOLDERCORNER = 65;
MSO_SPT_LEFTARROW = 66;
MSO_SPT_DOWNARROW = 67;
MSO_SPT_UPARROW = 68;
MSO_SPT_LEFTRIGHTARROW = 69;
MSO_SPT_UPDOWNARROW = 70;
MSO_SPT_IRREGULARSEAL1 = 71;
MSO_SPT_IRREGULARSEAL2 = 72;
MSO_SPT_LIGNTNINGBOLT = 73;
MSO_SPT_HEART = 74;
MSO_SPT_PICTUREFRAME = 75;
MSO_SPT_QUADARROW = 76;
MSO_SPT_LEFTARROWCALLOUT = 77;
MSO_SPT_RIGHTARROWCALLOUT = 78;
MSO_SPT_UPARROWCALLOUT = 79;
MSO_SPT_DOWNARROWCALLOUT = 80;
MSO_SPT_LEFTRIGHTARROWCALLOUT = 81;
MSO_SPT_UPDOWNARROWCALLOUT = 82;
MSO_SPT_QUADARROWCALLOUT = 83;
MSO_SPT_BEVEL = 84;
MSO_SPT_LEFTBRACKET = 85;
MSO_SPT_RIGHTBRACKET = 86;
MSO_SPT_LEFTBRACE = 87;
MSO_SPT_RIGHTBRACE = 88;
MSO_SPT_LEFTUPARROW = 89;
MSO_SPT_BENTUPARROW = 90;
MSO_SPT_BENTARROW = 91;
MSO_SPT_SEAL25 = 92;
MSO_SPT_STRIPEDRIGHTARROW = 83;
MSO_SPT_NOTCHEDRIGHTARROW = 84;
MSO_SPT_BLOCKARC = 95;
MSO_SPT_SMILIEYFACE = 96;
MSO_SPT_VERTICALSCROLL = 97;
MSO_SPT_HORIZONTALSCROLL = 98;
MSO_SPT_CICRULARARROW = 99;
MSO_SPT_NOTCHEDCIRCULARARROW = 100;
MSO_SPT_UTURNARROW = 101;
MSO_SPT_CURVEDRIGHTARROW = 102;
MSO_SPT_CURVEDLEFTARROW = 103;
MSO_SPT_CURVEDUPARROW = 104;
MSO_SPT_CURVEDDOWNARROW = 105;
MSO_SPT_CLOUDCALLOUT = 106;
MSO_SPT_ELLIPSERIBBON = 107;
MSO_SPT_ELLIPSERIBBON2 = 108;
MSO_SPT_FLOWCHARTPROCESS = 109;
MSO_SPT_FLOWCHARTDECISION = 110;
MSO_SPT_FLOWCHARTINPUTOUTPUT = 111;
MSO_SPT_FLOWCHARTPREDEFINEDPROCESS = 112;
MSO_SPT_FLOWCHARTINTERNALSTORAGE = 113;
MSO_SPT_FLOWCHARTDOCUMENT = 114;
MSO_SPT_FLOWCHARTMULTIDOCUMENT = 115;
MSO_SPT_FLOWCHARTTERMINATOR = 116;
MSO_SPT_FLOWCHARTPREPARATION = 117;
MSO_SPT_FLOWCHARTMANUALINPUT = 118;
MSO_SPT_FLOWCHARTMANUALOPERATION = 119;
MSO_SPT_FLOWCHARTCONNECTOR = 120;
MSO_SPT_FLOWCHARTPUNCHEDCARD = 121;
MSO_SPT_FLOWCHARTPUNCHEDTAPE = 122;
MSO_SPT_FLOWCHARTSUMMINGJUNCTION = 123;
MSO_SPT_FLOWCHARTOR = 124;
MSO_SPT_FLOWCHARTCOLLATE = 125;
MSO_SPT_FLOWCHARTSORT = 126;
MSO_SPT_FLOWCHARTEXTRACT = 127;
MSO_SPT_FLOWCHARTMERGE = 128;
MSO_SPT_FLOWCHARTOFFLINESTORAGE = 129;
MSO_SPT_FLOWCHARTONLINESTORAGE = 130;
MSO_SPT_FLOWCHARTMAGNETICTAPE = 131;
MSO_SPT_FLOWCHARTMAGNETICDISK = 132;
MSO_SPT_FLOWCHARTMAGNETICDRUM = 133;
MSO_SPT_FLOWCHARTDISPLAY = 134;
MSO_SPT_FLOWCHARTDELAY = 135;
MSO_SPT_TEXTPLAINTEXT = 136;
MSO_SPT_TEXTSTOP = 137;
MSO_SPT_TEXTTRIANGLE = 138;
MSO_SPT_TEXTTRIANGLEINVERTED = 139;
MSO_SPT_TEXTCHEVRON = 140;
MSO_SPT_TEXTCHEVRONINVERTED = 141;
MSO_SPT_TEXTRINGINSIDE = 142;
MSO_SPT_TEXTRINGOUTSIDE = 143;
MSO_SPT_TEXTARCHUPCURVE = 144;
MSO_SPT_TEXTARCHDOWNCURVE = 145;
MSO_SPT_TEXTCIRCLECURVE = 146;
MSO_SPT_TEXTBUTTONCURVE = 147;
MSO_SPT_TEXTARCHUPPOUR = 148;
MSO_SPT_TEXTARCHDOWNPOUR = 149;
MSO_SPT_TEXTCIRCLEPOUR = 150;
MSO_SPT_TEXTBUTTONPOUR = 151;
MSO_SPT_TEXTCURVEUP = 152;
MSO_SPT_TEXTCURVEDOWN = 153;
MSO_SPT_TEXTCASCADEUP = 154;
MSO_SPT_TEXTCASCADEDOWN = 155;
MSO_SPT_TEXTWAVE1 = 156;
MSO_SPT_TEXTWAVE2 = 157;
MSO_SPT_TEXTWAVE3 = 158;
MSO_SPT_TEXTWAVE4 = 159;
MSO_SPT_TEXTINFLATE = 160;
MSO_SPT_TEXTDEFLATE = 161;
MSO_SPT_TEXTINFLATEBOTTOM = 162;
MSO_SPT_TEXTDEFLATEBOTTOM = 163;
MSO_SPT_TEXTINFLATETOP = 164;
MSO_SPT_TEXTDEFLATETOP = 165;
MSO_SPT_TEXTDEFLATEINFLATE = 166;
MSO_SPT_TEXTDEFLATEINFLATEDEFLATE = 167;
MSO_SPT_TEXTFADERIGHT = 168;
MSO_SPT_TEXTFADELEFT = 169;
MSO_SPT_TEXTFADEUP = 170;
MSO_SPT_TEXTFADEDOWN = 171;
MSO_SPT_TEXTSLANTUP = 172;
MSO_SPT_TEXTSLANTDOWN = 173;
MSO_SPT_TEXTCANUP = 174;
MSO_SPT_TEXTCANDOWN = 175;
MSO_SPT_FLOWCHARTALTERNATEPROCESS = 176;
MSO_SPT_FLOWCHARTOFFPAGECONNECTOR = 177;
MSO_SPT_CALLOUT90 = 178;
MSO_SPT_ACCENTCALLOUT90 = 179;
MSO_SPT_BORDERCALLOUT90 = 180;
MSO_SPT_ACCENTBORDERCALLOUT90 = 181;
MSO_SPT_LEFTRIGHTUPARROW = 182;
MSO_SPT_SUN = 183;
MSO_SPT_MOON = 184;
MSO_SPT_BRACKETPAIR = 185;
MSO_SPT_BRACEPAIR = 186;
MSO_SPT_SEAL4 = 187;
MSO_SPT_DOUBLEWAVE = 188;
MSO_SPT_ACTIONBUTTONBLANK = 189;
MSO_SPT_ACTIONBUTTONHOME = 190;
MSO_SPT_ACTIONBUTTONHELP = 191;
MSO_SPT_ACTIONBUTTONINFORMATION = 192;
MSO_SPT_ACTIONBUTTONFORWARDNEXT = 193;
MSO_SPT_ACTIONBUTTONBACKPREVIOUS = 194;
MSO_SPT_ACTIONBUTTONEND = 195;
MSO_SPT_ACTIONBUTTONBEGINNING = 196;
MSO_SPT_ACTIONBUTTONRETURN = 197;
MSO_SPT_ACTIONBUTTONDOCUMENT = 198;
MSO_SPT_ACTIONBUTTONSOUND = 199;
MSO_SPT_ACTIONBUTTONMOVIE = 200;
MSO_SPT_HOSTCONTROL = 201;
MSO_SPT_TEXTBOX = 202;
MSO_SPT_NIL = $0FFF;
MSO_SPT_MAX = MSO_SPT_NIL;
{ Bits in OfficeArtFSp record }
MSO_FSP_BITS_GROUP = $00000001;
MSO_FSP_BITS_CHILD = $00000002;
MSO_FSP_BITS_PATRIARCH = $00000004;
MSO_FSP_BITS_DELETED = $00000008;
MSO_FSP_BITS_OLESHAPE = $00000010;
MSO_FSP_BITS_HASMASTER = $00000020;
MSO_FSP_BITS_FLIPHOR = $00000040;
MSO_FSP_BITS_FLIPVERT = $00000080;
MSO_FSP_BITS_CONNECTOR = $00000100;
MSO_FSP_BITS_HASANCHOR = $00000200;
MSO_FSP_BITS_BACKGROUND = $00000400;
MSO_FSP_BITS_HASSHAPETYPE = $00000800;
{ Identifier of property array items if OfficeArtFOpt record }
MSO_FOPT_ID_TEXTID = $0080;
MSO_FOPT_ID_TEXTDIRECTION = $008B;
MSO_FOPT_ID_TEXTBOOL = $00BF;
MSO_FOPT_ID_CONNECTIONPOINTTYPE = $0158;
MSO_FOPT_ID_FILLCOLOR = $0181;
MSO_FOPT_ID_FILLBACKGROUNDCOLOR = $0183;
MSO_FOPT_ID_FILLFOREGROUNDCOLOR = $0185;
MSO_FOPT_ID_FILLBOOL = $01BF;
MSO_FOPT_ID_SHADOWCOLOR = $0201;
MSO_FOPT_ID_SHADOWBOOL = $023F;
MSO_FOPT_ID_GROUPBOOL = $03BF;
procedure WriteMSOClientAnchorSheetRecord(AStream: TStream;
ATopRow, ALeftCol, ABottomRow, ARightCol,
ALeftMargin, ARightMargin, ATopMargin, ABottomMargin: Word;
AMoveIntact, AResizeIntact: Boolean);
procedure WriteMSOClientDataRecord(AStream: TStream);
procedure WriteMSOClientTextboxRecord(AStream: TStream);
procedure WriteMSODgContainer(AStream: TStream; ASize: DWord);
procedure WriteMSOFDgRecord(AStream: TStream; ANumShapes, ADrawingID, ALastObjID: Word);
procedure WriteMSOFOptRecord_Comment(AStream: TStream);
procedure WriteMSOProperty(AStream: TStream; APropertyID: Word; AValue: DWord);
procedure WriteMSOFSpRecord(AStream: TStream; AShapeID: DWord; AShapeType: Word; ABits: DWord);
procedure WriteMSOFSpGrRecord(AStream: TStream; ALeft, ATop, ARight, ABottom: DWord);
procedure WriteMSOHeader(AStream: TStream; AType, AVersion, AInstance: Word; ARecSize: DWord);
procedure WriteMSOSpContainer(AStream: TStream; ASize: DWord);
procedure WriteMSOSpGrContainer(AStream: TStream; ASize: DWord);
implementation
uses
fpsutils;
type
TsMSOHeader = packed record
Version_Instance: Word;
RecordType: Word;
RecordSize: DWord;
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArtClientAnchorSheet record to a stream.
The OfficeArtClientAnchorSheet structure specifies the anchor position of
a drawing object embedded in a sheet.
Ref: [MS-XLS].pdf
-------------------------------------------------------------------------------}
procedure WriteMSOClientAnchorSheetRecord(AStream: TStream;
ATopRow, ALeftCol, ABottomRow, ARightCol,
ALeftMargin, ARightMargin, ATopMargin, ABottomMargin: Word;
AMoveIntact, AResizeIntact: Boolean);
const
fMOVE = $0001; // specifies whether the shape will be kept intact when the cells are moved.
fSIZE = $0002; // specifies whether the shape will be kept intact when the cells are resized.
var
flags: Word;
begin
WriteMSOHeader(AStream, MSO_ID_OFFICEART_CLIENTANCHORSHEET, 0, 0, 18);
flags := 0;
if AMoveIntact then begin
AResizeIntact := true;
flags := flags or fMOVE;
end;
if AResizeIntact then
flags := flags or fSIZE;
AStream.WriteWord(WordToLE(flags));
// Column of the cell under the top left corner of the bounding rectangle of the shape.
AStream.WriteWord(WordLEToN(ALeftCol));
// x coordinate of the top left corner of the bounding rectangle relative to
// the corner of the underlying cell.
// The value is expressed as 1024th’s of that cell’s width.
AStream.WriteWord(WordLEToN(ALeftMargin));
// Row of the cell under the top left corner of the bounding rectangle of the shape.
AStream.WriteWord(WordLEToN(ATopRow));
// y coordinate of the top left corner of the bounding rectangle relative to
// the corner of the underlying cell.
// The value is expressed as 256th’s of that cell’s height.
AStream.WriteWord(WordLEToN(ATopMargin));
// Column of the cell under the bottom right corner of the bounding rectangle
// of the shape.
AStream.WriteWord(WordToLE(ARightCol));
// x coordinate of the bottom right corner of the bounding rectangle relative
// to the corner of the underlying cell.
// The value is expressed as 1024th’s of that cell’s width.
AStream.WriteWord(WordToLE(ARightMargin));
// Row of the cell under the bottom right corner of the bounding rectangle
// of the shape.
AStream.WriteWord(WordToLE(ABottomRow));
// y coordinate of the bottom right corner of the bounding rectangle relative
// to the corner of the underlying cell.
// The value is expressed as 256th’s of that cell’s height.
AStream.WriteWord(WordToLE(ABottomMargin));
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArtClientData record to a stream
The OfficeArtClientData structure specifies the client data of a drawing
object.
MUST be the last structure of the rgChildRec field of the current
MSODRAWING BIFF record.
The next record MUST be OBJ which contains the detailed data information
about this drawing object.
-------------------------------------------------------------------------------}
procedure WriteMSOClientDataRecord(AStream: TStream);
begin
WriteMSOHeader(AStream, MSO_ID_OFFICEART_CLIENTDATA, 0, 0, 0);
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArtClientTextbox record to a stream
-------------------------------------------------------------------------------}
procedure WriteMSOClientTextboxRecord(AStream: TStream);
begin
WriteMSOHeader(AStream, MSO_ID_OFFICEART_CLIENTTEXTBOX, 0, 0, 0);
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArtDgContainer record to a stream.
The OfficeArtDgContainer record specifies the container for all file records
for the objects in an MSO drawing.
-------------------------------------------------------------------------------}
procedure WriteMSODgContainer(AStream: TStream; ASize: DWord);
begin
WriteMSOHeader(AStream, MSO_ID_OFFICEART_DG_CONTAINER, MSO_VER_CONTAINER, 0, ASize);
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArt FDG record to a stream.
The OfficeArtFDG record specifies the number of shapes, the drawing identifier,
and the shape identifier of the last shape in a drawing.
-------------------------------------------------------------------------------}
procedure WriteMSOFdgRecord(AStream: TStream; ANumShapes, ADrawingID, ALastObjID: Word);
begin
if ADrawingID > $0FFE then
raise Exception.CreateFmt('[WriteMSOFdgRecord] Invalid drawing identifier $%.4x', [ADrawingID]);
WriteMSOHeader(AStream, MSO_ID_OFFICEART_FDG, 0, ADrawingID, 8);
AStream.WriteDWord(DWordToLE(ANumShapes));
AStream.WriteDWord(DWordToLE(ALastObjID));
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArtFOpt as it is used for a cell comment record to the stream
The OfficeArtFOPT record specifies a table of OfficeArtRGFOPTE records,
The OfficeArtRGFOPTE record specifies a property table, which consists of an
array of fixed-size property table entries, followed by a variable-length
field of complex data.
-------------------------------------------------------------------------------}
procedure WriteMSOFOptRecord_Comment(AStream: TStream);
const
NUM_PROPERTIES = 13;
begin
// Escher header
WriteMSOHeader(AStream, MSO_ID_OFFICEART_FOPT, 3, NUM_PROPERTIES, NUM_PROPERTIES*6);
// TextID
WriteMSOProperty(AStream, MSO_FOPT_ID_TEXTID, 0);
// Text direction
WriteMSOProperty(AStream, MSO_FOPT_ID_TEXTDIRECTION, 2); // 2 = "determined from text string"
// Boolean properties of text in a shape
WriteMSOProperty(AStream, MSO_FOPT_ID_TEXTBOOL, $00080008);
// Type of connection point
WriteMSOProperty(AStream, MSO_FOPT_ID_CONNECTIONPOINTTYPE, 0);
// Fill color
WriteMSOProperty(AStream, MSO_FOPT_ID_FILLCOLOR, $00E1FFFF);
// Background color of fill
WriteMSOProperty(AStream, MSO_FOPT_ID_FILLBACKGROUNDCOLOR, $00E1FFFF);
// Foreground color of fill
WriteMSOProperty(AStream, MSO_FOPT_ID_FILLFOREGROUNDCOLOR, $100000F4);
// Fill style boolean properties
WriteMSOProperty(AStream, MSO_FOPT_ID_FILLBOOL, $00100010);
// Line foreground color for black-and-white mode
WriteMSOProperty(AStream, $01C3, $100000F4);
// Shadow color
WriteMSOProperty(AStream, MSO_FOPT_ID_SHADOWCOLOR, 0);
// Shadow color primary color modifier if in black-and-white mode
WriteMSOProperty(AStream, $0203, $100000F4);
// Shadow style boolean properties
WriteMSOProperty(AStream, MSO_FOPT_ID_SHADOWBOOL, $00030003);
// Group shape boolean properties
WriteMSOProperty(AStream, MSO_FOPT_ID_GROUPBOOL, $00020002);
end;
{@@ ----------------------------------------------------------------------------
Writes a property of the FOPT array
-------------------------------------------------------------------------------}
procedure WriteMSOProperty(AStream: TStream; APropertyID: Word;
AValue: DWord);
begin
AStream.WriteWord(WordToLE(APropertyID));
AStream.WriteDWord(DWordToLE(AValue));
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArtFSp record to the stream
The OfficeArtFSP record specifies an instance of a shape.
The record header contains the shape type, and the record itself contains
the shape identifier and a set of bits that further define the shape.
-------------------------------------------------------------------------------}
procedure WriteMSOFSpRecord(AStream: TStream; AShapeID: DWord;
AShapeType: Word; ABits: DWord);
begin
WriteMSOHeader(AStream, MSO_ID_OFFICEART_FSP, 2, AShapeType, 8);
AStream.WriteDWord(DWordToLE(AShapeID));
AStream.WriteDWord(DWordToLE(ABits));
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArtFSpGr record to the stream.
The OfficeArtFSPGR record specifies the coordinate system of the group shape
that the anchors of the child shape are expressed in.
This record is present only for group shapes.
-------------------------------------------------------------------------------}
procedure WriteMSOFSpGrRecord(AStream: TStream; ALeft, ATop, ARight, ABottom: DWord);
begin
WriteMSOHeader(AStream, MSO_ID_OFFICEART_FSPGR, 1, 0, 16);
AStream.WriteDWord(DWordToLE(ALeft));
AStream.WriteDWord(DWordToLE(ATop));
AStream.WriteDWord(DWordToLE(ARight));
AStream.WriteDWord(DWordToLE(ABottom));
end;
{ Writes the header of an MSO subrecord used internally by MSODRAWING records }
procedure WriteMSOHeader(AStream: TStream; AType, AVersion, AInstance: Word;
ARecSize: DWord);
var
rec: TsMSOHeader;
begin
rec.Version_Instance := WordToLE((AVersion and $000F) + AInstance shl 4); //and $FFF0) shr 4);
// To do: How to handle Version_Instance on big-endian machines?
// Version_Instance combines bits 0..3 for "version" and 4..15 for "instance"
rec.RecordType := WordToLE(AType);
rec.RecordSize := DWordToLE(ARecSize);
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{@@ ----------------------------------------------------------------------------
Writes an OffcieARtSpContainer record to the stream.
The OfficeArtSpContainer record specifies a shape container.
-------------------------------------------------------------------------------}
procedure WriteMSOSpContainer(AStream: TStream; ASize: DWord);
begin
WriteMSOHeader(AStream, MSO_ID_OFFICEART_SP_CONTAINER, MSO_VER_CONTAINER, 0, ASize);
end;
{@@ ----------------------------------------------------------------------------
Writes an OfficeArtSpGrContainer record to a stream.
The OfficeArtSpgrContainer record specifies a container for groups of shapes.
The group container contains a variable number of shape containers and other
group containers. Each group is a shape. The first container MUST be an
OfficeArtSpContainer record, which MUST contain shape information for the
group.
-------------------------------------------------------------------------------}
procedure WriteMSOSpGrContainer(AStream: TStream; ASize: DWord);
begin
WriteMSOHeader(AStream, MSO_ID_OFFICEART_SPGR_CONTAINER, MSO_VER_CONTAINER, 0, ASize);
end;
end.