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

fpspreadsheet: Fix rich-text ignoring non-ansi characters. Beginning to handle rich-text formatting runs when reading biff5 files.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4204 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-07-09 15:29:44 +00:00
parent 9b89738158
commit 5b319c45bf
4 changed files with 117 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/fpspreadsheet/fpstypes.pas
View File

@ -431,6 +431,15 @@ type
{@@ Parameters describing formatting of text ranges in cell text }
TsRichTextParams = array of TsRichTextParam;
{@@ Excel rich-text formatting run }
TsRichTextFormattingRun = record
FirstIndex: Integer;
FontIndex: Integer;
end;
{@@ Array of Excel rich-text formatting runs }
TsRichTextFormattingRuns = array of TsRichTextFormattingRun;
{@@ Indicates the border for a cell. If included in the CellBorders set the
corresponding border is drawn in the style defined by the CellBorderStyle. }
TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown);

57
components/fpspreadsheet/fpsvisualutils.pas
View File

@ -263,7 +263,6 @@ var
procedure ScanLine(var P: PChar; var NumSpaces: Integer;
var PendingRtpIndex: Integer; var width, height: Integer);
var
ch: Char;
pEOL: PChar;
savedSpaces: Integer;
savedWidth: Integer;
@ -273,6 +272,8 @@ var
dw, h: Integer;
fntpos: TsFontPosition;
spaceFound: Boolean;
s: utf8String;
charLen: Integer;
begin
NumSpaces := 0;
@ -299,15 +300,15 @@ var
UpdateFont(p, rtState, PendingRtpIndex, h, fntpos);
if h > height then height := h;
ch := p^;
case ch of
s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen));
case p^ of
' ': begin
spaceFound := true;
pEOL := p;
savedWidth := width;
savedSpaces := NumSpaces;
savedRtpIndex := PendingRtpIndex;
dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(ch));
dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(s));
if width + dw < MaxWidth then
begin
inc(NumSpaces);
@ -324,7 +325,7 @@ var
exit;
end;
else begin
dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(ch));
dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(s));
width := width + dw;
if width > maxWidth then
begin
@ -345,69 +346,70 @@ var
end;
end;
inc(P, UTF8CharacterLength(p));
inc(p, charLen);
end;
end;
procedure DrawLine(pStart, pEnd: PChar; x,y, hLine: Integer; PendingRtpIndex: Integer);
var
ch: Char;
p: PChar;
rtState: TRtState;
h, w: Integer;
fntpos: TsFontPosition;
s: utf8String;
charLen: Integer;
begin
p := pStart;
InitFont(p, rtState, PendingRtpIndex, h);
while p^ <> #0 do begin
s := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen));
UpdateFont(p, rtState, PendingRtpIndex, h, fntpos);
ch := p^;
case ARotation of
trHorizontal:
begin
ACanvas.Font.Orientation := 0;
case fntpos of
fpNormal : ACanvas.TextOut(x, y, ch);
fpSubscript : ACanvas.TextOut(x, y + hLine div 2, ch);
fpSuperscript: ACanvas.TextOut(x, y - hLine div 6, ch);
fpNormal : ACanvas.TextOut(x, y, s);
fpSubscript : ACanvas.TextOut(x, y + hLine div 2, s);
fpSuperscript: ACanvas.TextOut(x, y - hLine div 6, s);
end;
inc(x, ACanvas.TextWidth(ch));
inc(x, ACanvas.TextWidth(s));
end;
rt90DegreeClockwiseRotation:
begin
ACanvas.Font.Orientation := -900;
case fntpos of
fpNormal : ACanvas.TextOut(x, y, ch);
fpSubscript : ACanvas.TextOut(x - hLine div 2, y, ch);
fpSuperscript: ACanvas.TextOut(x + hLine div 6, y, ch);
fpNormal : ACanvas.TextOut(x, y, s);
fpSubscript : ACanvas.TextOut(x - hLine div 2, y, s);
fpSuperscript: ACanvas.TextOut(x + hLine div 6, y, s);
end;
inc(y, ACanvas.TextWidth(ch));
inc(y, ACanvas.TextWidth(s));
end;
rt90DegreeCounterClockwiseRotation:
begin
ACanvas.Font.Orientation := +900;
case fntpos of
fpNormal : ACanvas.TextOut(x, y, ch);
fpSubscript : ACanvas.TextOut(x + hLine div 2, y, ch);
fpSuperscript: ACanvas.TextOut(x - hLine div 6, y, ch);
fpNormal : ACanvas.TextOut(x, y, s);
fpSubscript : ACanvas.TextOut(x + hLine div 2, y, s);
fpSuperscript: ACanvas.TextOut(x - hLine div 6, y, s);
end;
dec(y, ACanvas.TextWidth(ch));
dec(y, ACanvas.TextWidth(s));
end;
rtStacked:
begin
ACanvas.Font.Orientation := 0;
w := ACanvas.TextWidth(ch);
w := ACanvas.TextWidth(s);
// chars centered around x
case fntpos of
fpNormal : ACanvas.TextOut(x - w div 2, y, ch);
fpSubscript : ACanvas.TextOut(x - w div 2, y + hLine div 2, ch);
fpSuperscript: ACanvas.TextOut(x - w div 2, y - hLine div 6, ch);
fpNormal : ACanvas.TextOut(x - w div 2, y, s);
fpSubscript : ACanvas.TextOut(x - w div 2, y + hLine div 2, s);
fpSuperscript: ACanvas.TextOut(x - w div 2, y - hLine div 6, s);
end;
inc(y, h);
end;
end;
inc(P, UTF8CharacterLength(p));
inc(P, charLen);
if P >= PEnd then break;
end;
end;
@ -425,11 +427,10 @@ begin
iRtp := -1;
totalHeight := 0;
if ARotation = rtStacked then
begin
Convert_sFont_to_Font(AWorkbook.GetFont(AFontIndex), ACanvas.Font);
if ARotation = rtStacked then
stackPeriod := ACanvas.TextWidth('M') * 2;
end;
// Get layout of lines:
// "lineinfos" collect data on where lines start and end, their width and

29
components/fpspreadsheet/xlsbiff5.pas
View File

@ -516,18 +516,20 @@ end;
procedure TsSpreadBIFF5Reader.ReadRichString(AStream: TStream);
var
L: Word;
B: BYTE;
B, F: Byte;
ARow, ACol: Cardinal;
XF: Word;
AStrValue: ansistring;
ansistr: ansistring;
valueStr: UTF8String;
cell: PCell;
rtfRuns: TsRichTextFormattingRuns;
begin
ReadRowColXF(AStream, ARow, ACol, XF);
{ Byte String with 16-bit size }
L := WordLEtoN(AStream.ReadWord());
SetLength(AStrValue,L);
AStream.ReadBuffer(AStrValue[1], L);
L := WordLEtoN(AStream.ReadWord);
SetLength(ansistr, L);
AStream.ReadBuffer(ansistr[1], L);
{ Create cell }
if FIsVirtualMode then begin
@ -537,16 +539,20 @@ begin
cell := FWorksheet.AddCell(ARow, ACol);
{ Save the data }
FWorksheet.WriteUTF8Text(cell, ISO_8859_1ToUTF8(AStrValue));
//Read formatting runs (not supported)
valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8);
FWorksheet.WriteUTF8Text(cell, valuestr);
// Read rich-text formatting runs
B := AStream.ReadByte;
SetLength(rtfRuns, B);
for L := 0 to B-1 do begin
AStream.ReadByte; // First formatted character
AStream.ReadByte; // Index to FONT record
rtfRuns[L].FirstIndex := AStream.ReadByte; // Index of first formatted character
rtfRuns[L].FontIndex := AStream.ReadByte; // Index of font used
end;
{ Add attributes to cell }
ApplyCellFormatting(cell, XF);
ApplyRichTextFormattingRuns(cell, rtfRuns);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
@ -626,7 +632,7 @@ var
dw: DWord;
fill: Word;
fs: TsFillStyle;
fnt: TsFont;
// fnt: TsFont;
begin
InitFormatRecord(fmt);
fmt.ID := FCellFormatList.Count;
@ -638,10 +644,13 @@ begin
// Font index
i := WordLEToN(rec.FontIndex);
if i > 4 then dec(i); // Watch out for the nasty missing font #4...
fmt.FontIndex := FixFontIndex(i);
{
fnt := TsFont(FFontList[i]);
fmt.FontIndex := Workbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
if fmt.FontIndex = -1 then
fmt.FontIndex := Workbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
}
if fmt.FontIndex > 1 then
Include(fmt.UsedFormattingFields, uffFont);

61
components/fpspreadsheet/xlscommon.pas
View File

@ -353,14 +353,18 @@ type
FIncompleteNoteLength: Word;
FFirstNumFormatIndexInFile: Integer;
FPalette: TsPalette;
procedure AddBuiltinNumFormats; override;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; //overload;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual;
procedure ApplyRichTextFormattingRuns(ACell: PCell;
ARuns: TsRichTextFormattingRuns);
// Extracts a number out of an RK value
function DecodeRKValue(const ARK: DWORD): Double;
// Returns the numberformat for a given XF record
procedure ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); virtual;
procedure FixColors;
function FixFontIndex(AFontIndex: Integer): Integer;
// Tries to find if a number cell is actually a date/datetime/time cell and retrieves the value
function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat;
ANumberFormatStr: String; out ADateTime: TDateTime): Boolean;
@ -837,6 +841,46 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Converts the rich-text formatting run data as read from the file to the
internal format used by the cell.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFFReader.ApplyRichTextFormattingRuns(ACell: PCell;
ARuns: TsRichTextFormattingRuns);
var
fntIndex: Integer;
cellFntIndex: Integer;
cellStr: String;
i: Integer;
begin
if Length(ARuns) = 0 then
exit;
cellStr := ACell^.UTF8StringValue;
cellFntIndex := FWorksheet.ReadCellFontIndex(ACell);
SetLength(ACell^.RichTextParams, 0);
for i := 0 to High(ARuns) do begin
// Make sure that the fontindex defined in the formatting runs array points to
// the workbook's fontlist, not to the reader's fontlist.
fntIndex := FixFontIndex(ARuns[i].FontIndex);
// Ony fonts different from the cell's standard font are considered to be
// elements in the TsRichTextParams array used by the cell.
if fntIndex <> cellFntIndex then
begin
SetLength(ACell^.RichTextParams, Length(ACell^.RichTextParams)+1);
with ACell^.RichTextParams[High(ACell^.RichTextParams)] do
begin
FontIndex := fntIndex;
StartIndex := ARuns[i].FirstIndex;
if i < High(ARuns) then
EndIndex := ARuns[i+1].FirstIndex else
EndIndex := Length(cellStr);
end;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Extracts a number out of an RK value.
Valid since BIFF3.
@ -934,6 +978,21 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Converts the index of a font in the reader fontlist to the index of this font
in the workbook's fontlist. If the font is not yet contained in the workbook
fontlist it is added.
-------------------------------------------------------------------------------}
function TsSpreadBIFFReader.FixFontIndex(AFontIndex: Integer): Integer;
var
fnt: TsFont;
begin
fnt := TsFont(FFontList[AFontIndex]);
Result := FWorkbook.FindFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
if Result = -1 then
Result := FWorkbook.AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color, fnt.Position);
end;
{@@ ----------------------------------------------------------------------------
Converts the number to a date/time and return that if it is
-------------------------------------------------------------------------------}