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

fpspreadsheet: Fill unused BIFF5 and BIFF8 palette entries by default colors to avoid Excel XP show an incomplete color dialog.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5863 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-05-18 10:50:22 +00:00
parent 2c7195cf55
commit 078274920d
5 changed files with 45 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
components/fpspreadsheet/source/common/xlsbiff2.pas
View File

@ -111,6 +111,7 @@ type
procedure AddBuiltinNumFormats; override;
function FunctionSupported(AExcelCode: Integer;
const AFuncName: String): Boolean; override;
procedure PopulatePalette(AWorkbook: TsWorkbook); override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
@ -1308,6 +1309,16 @@ begin
end;
end;
procedure TsSpreadBIFF2Writer.PopulatePalette(AWorkbook: TsWorkbook);
begin
FPalette.Clear;
FPalette.AddBuiltinColors(false);
// The next instruction creates an error log entry if the workbook contains
// more colors than the default 8. This is because BIFF2 can only have a
// palette with 8 colors.
FPalette.CollectFromWorkbook(AWorkbook);
end;
(*
{@@ ----------------------------------------------------------------------------
Builds up the list of number formats to be written to the biff2 file.

14
components/fpspreadsheet/source/common/xlsbiff5.pas
View File

@ -99,6 +99,7 @@ type
protected
function FunctionSupported(AExcelCode: Integer; const AFuncName: String): Boolean; override;
procedure InternalWriteToStream(AStream: TStream);
procedure PopulatePalette(AWorkbook: TsWorkbook); override;
{ Record writing methods }
procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; AWorkSheet: TsWorksheet): Int64;
@ -1229,6 +1230,19 @@ begin
SetLength(sheetPos, 0);
end;
procedure TsSpreadBIFF5Writer.PopulatePalette(AWorkbook: TsWorkbook);
var
i: Integer;
begin
FPalette.Clear;
FPalette.AddBuiltinColors(true);
FPalette.CollectFromWorkbook(AWorkbook);
// Fill up Excel colors of the standard palette to avoid empty color
// place holders in Excel's colordialog.
for i := 16 to High(PALETTE_BIFF5) do
FPalette.AddUniqueColor(PALETTE_BIFF5[i]);
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF5 file to the disc

11
components/fpspreadsheet/source/common/xlsbiff8.pas
View File

@ -136,7 +136,7 @@ type
protected
function GetPrintOptions: Word; override;
procedure InternalWriteToStream(AStream: TStream);
procedure PopulatePalette; override;
procedure PopulatePalette(AWorkbook: TsWorkbook); override;
{ Record writing methods }
procedure WriteBOF(AStream: TStream; ADataType: Word);
@ -2226,10 +2226,17 @@ begin
SetLength(sheetPos, 0);
end;
procedure TsSpreadBIFF8Writer.PopulatePalette;
procedure TsSpreadBIFF8Writer.PopulatePalette(AWorkbook: TsWorkbook);
var
i: Integer;
begin
FPalette.Clear;
FPalette.AddBuiltinColors(true);
FPalette.CollectFromWorkbook(AWorkbook);
// Fill up Excel colors of the standard palette to avoid empty color
// place holders in Excel's colordialog.
for i := 16 to High(PALETTE_BIFF8) do
FPalette.AddUniqueColor(PALETTE_BIFF8[i]);
end;
{@@ ----------------------------------------------------------------------------

20
components/fpspreadsheet/source/common/xlscommon.pas
View File

@ -534,7 +534,7 @@ type
function GetLastColIndex(AWorksheet: TsWorksheet): Word;
function GetPrintOptions: Word; virtual;
function PaletteIndex(AColor: TsColor): Word;
procedure PopulatePalette; virtual;
procedure PopulatePalette(AWorkbook: TsWorkbook); virtual;
// Helper function for writing the BIFF header
procedure WriteBIFFHeader(AStream: TStream; ARecID, ARecSize: Word);
@ -3074,8 +3074,7 @@ begin
// Color palette
FPalette := TsPalette.Create;
PopulatePalette;
FPalette.CollectFromWorkbook(AWorkbook);
PopulatePalette(AWorkbook);
end;
destructor TsSpreadBIFFWriter.Destroy;
@ -3239,15 +3238,14 @@ begin
Result := word(idx);
end;
procedure TsSpreadBIFFWriter.PopulatePalette;
{@@ ----------------------------------------------------------------------------
Populates the color palette of the BIFF writer. Must be overridden by
descendants.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFWriter.PopulatePalette(AWorkbook: TsWorkbook);
begin
with FPalette do
begin
Clear;
AddBuiltinColors(false); // 0..7
// Note: These colors cannot be edited by Excel. The format specific
// writer must duplicate these items (except for BIFF2).
end;
Unused(AWorkbook);
FPalette.Clear;
end;
{@@ ----------------------------------------------------------------------------

12
components/fpspreadsheet/tests/errortests.pas
View File

@ -65,14 +65,6 @@ const
(Format: sfOOXML; MaxRowCount: 1048576; MaxColCount: 16384; MaxCellLen: $FFFFFFFF),
(Format: sfOpenDocument; MaxRowCount: 1048576; MaxColCount: 1024; MaxCellLen: $FFFFFFFF)
);
(*
type
TTestFormat = (sfExcel2, sfExcel5, sfExcel8, sfExcelXML, sfOOXML, sfOpenDocument);
const // XLS2 XLS5 XLS8 XLSXML OOXML ODS
MAX_ROW_COUNT: array[TTestFormat] of Cardinal = (65536, 65536, 65536, 65536, 1048576, 1048576);
MAX_COL_COUNT: array[TTestFormat] of Cardinal = ( 256, 256, 256, 256, 16384, 1024);
MAX_CELL_LEN : array[TTestFormat] of Cardinal = ( 255, 255, 32767, 32767,$FFFFFFFF,$FFFFFFFF);
*)
var
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
@ -155,10 +147,10 @@ begin
// Prepare a full palette
palette := TsPalette.Create;
try
// Create random palette of 65 unique entries - 1 too many for Excel5/8
// Create random palette of 65 unique entries -> 1 too many for Excel5/8
// and a lot too many for BIFF2
palette.AddBuiltinColors;
for i:=8 to 65 do
for i:=palette.Count to 65 do
begin
repeat
newColor := random(256) + random(256) shl 8 + random(256) shl 16;