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

fpspreadsheet: Extend BIFFExplorer to display Rich-Text information attached to wide strings

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3504 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-29 15:02:00 +00:00
parent fa8632bb9a
commit 6fa634e0a2
5 changed files with 152 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
components/fpspreadsheet/examples/excel8demo/excel8read.lpi
View File

@ -31,7 +31,7 @@
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="laz_fpspreadsheet"/>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="1">
@ -44,13 +44,23 @@
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="excel8read"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</CONFIG>

2
components/fpspreadsheet/examples/excel8demo/excel8read.lpr
View File

@ -11,7 +11,7 @@ program excel8read;
uses
Classes, SysUtils, fpspreadsheet, xlsbiff8,
laz_fpspreadsheet, fpsutils;
fpsutils;
var
MyWorkbook: TsWorkbook;

1
components/fpspreadsheet/reference/BIFFExplorer/BIFFExplorer.lpi
View File

@ -155,7 +155,6 @@
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="beMain"/>
</Unit5>
<Unit6>
<Filename Value="beutils.pas"/>

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

@ -12,6 +12,18 @@ type
TBIFFDetailsEvent = procedure(Sender: TObject; ADetails: TStrings) of object;
TBIFF2RichTextRun = packed record // valid up to BIFF5
IndexToFirstChar: Byte;
FontIndex: Byte;
end;
TBIFF8RichTextRun = packed record
IndexToFirstChar: Word;
FontIndex: Word;
end;
TRichTextRuns = array of TBiff8RichTextRun;
TBIFFGrid = class(TStringGrid)
private
FRecType: Word;
@ -114,7 +126,11 @@ type
procedure Click; override;
procedure DoExtractDetails;
procedure ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer; IgnoreCompressedFlag: Boolean = false);
out AString: String; out ANumBytes: Integer; out AOffsetToAsianPhoneticBlock: Integer;
out AsianPhoneticBlockSize: DWord; out ARichTextRuns: TRichTextRuns;
AIgnoreCompressedFlag: Boolean = false); overload;
procedure ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer; AIgnoreCompressedFlag: Boolean = false); overload;
procedure PopulateGrid;
procedure ShowInRow(var ARow: Integer; var AOffs: LongWord; ASize: Word; AValue,ADescr: String);
procedure ShowRowColData(var ABufIndex: LongWord);
@ -131,7 +147,7 @@ type
implementation
uses
StrUtils, Math,
StrUtils, Math, lazutf8,
fpsutils,
beBIFFUtils;
@ -182,19 +198,32 @@ end;
procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer; IgnoreCompressedFlag: Boolean = false);
out AString: String; out ANumBytes: Integer; out AOffsetToAsianPhoneticBlock: Integer;
out AsianPhoneticBlockSize: DWord; out ARichTextRuns: TRichTextRuns;
AIgnoreCompressedFlag: Boolean = false);
var
i: Integer;
ls: Integer;
sa: ansiString;
sw: WideString;
w: Word;
optn: Byte;
bytesPerChar: Byte;
containsAsianPhonetics: Boolean;
containsRichText: Boolean;
richTextCount: Word = 0;
savedBufIndex: Integer;
begin
if Length(FBuffer) = 0 then begin
AString := '';
ANumBytes := 0;
AString := '';
ANumBytes := 0;
AOffsetToAsianPhoneticBlock := -1;
AsianPhoneticBlockSize := 0;
SetLength(ARichTextRuns, 0);
if Length(FBuffer) = 0 then
exit;
end;
savedBufIndex := ABufIndex;
if ALenBytes = 1 then
ls := FBuffer[ABufIndex]
else begin
@ -203,18 +232,48 @@ begin
end;
if AUnicode then begin
optn := FBuffer[ABufIndex + ALenBytes];
if (optn and $01 = 0) and (not IgnoreCompressedFlag)
then begin // compressed --> 1 byte per character
if (optn and $01 = 0) and (not AIgnoreCompressedFlag) then
bytesPerChar := 1
else
bytesPerChar := 2;
containsAsianPhonetics := (optn and $04 <> 0);
containsRichText := (optn and $08 <> 0);
ABufIndex := ABufIndex + ALenBytes + 1;
if containsRichText then begin
Move(FBuffer[ABufIndex], richTextCount, 2);
richTextCount := WordLEToN(richTextCount);
inc(ABufIndex, 2);
end;
if containsAsianPhonetics then begin
Move(FBuffer[ABufIndex], AsianPhoneticBlockSize, 4);
AsianPhoneticBlockSize := DWordLEToN(AsianPhoneticBlockSize);
inc(ABufIndex, 4);
end;
if bytesPerChar = 1 then begin
SetLength(sa, ls);
ANumbytes := ls*SizeOf(AnsiChar) + ALenBytes + 1;
Move(FBuffer[ABufIndex + ALenBytes + 1], sa[1], ls*SizeOf(AnsiChar));
AString := sa;
Move(FBuffer[ABufIndex], sa[1], ls*SizeOf(AnsiChar));
inc(ABufIndex, ls*SizeOf(AnsiChar));
AString := AnsiToUTF8(sa);
end else begin
SetLength(sw, ls);
ANumBytes := ls*SizeOf(WideChar) + ALenBytes + 1;
Move(FBuffer[ABufIndex + ALenBytes + 1], sw[1], ls*SizeOf(WideChar));
Move(FBuffer[ABufIndex], sw[1], ls*SizeOf(WideChar));
inc(ABufIndex, ls*SizeOf(WideChar));
AString := UTF8Encode(WideStringLEToN(sw));
end;
if containsRichText then begin
SetLength(ARichTextRuns, richTextCount);
Move(FBuffer[ABufIndex], ARichTextRuns[0], richTextCount*SizeOf(TBiff8RichTextRun));
for i:=0 to richTextCount-1 do begin
ARichTextRuns[i].IndexToFirstchar := WordLEToN(ARichTextRuns[i].IndexToFirstChar);
ARichTextRuns[i].FontIndex := WordLEToN(ARichTextRuns[i].FontIndex);
end;
inc(ABufIndex, richTextCount*SizeOf(word));
end;
if containsAsianPhonetics then begin
AOffsetToAsianPhoneticBlock := ABufIndex;
inc(ABufIndex, AsianPhoneticBlockSize);
end;
ANumBytes := ABufIndex - savedBufIndex;
end else begin
SetLength(sa, ls);
ANumBytes := ls*SizeOf(AnsiChar) + ALenBytes;
@ -223,6 +282,17 @@ begin
end;
end;
procedure TBIFFGrid.ExtractString(ABufIndex: Integer; ALenBytes: Byte; AUnicode: Boolean;
out AString: String; out ANumBytes: Integer; AIgnoreCompressedFlag: Boolean = false);
var
asianPhoneticBlockOffset: Integer;
asianPhoneticBlockSize: DWord;
richTextRuns: TRichTextRuns;
begin
ExtractString(ABufIndex, ALenBytes, AUnicode, AString, ANumBytes,
asianPhoneticBlockOffset, asianPhoneticBlockSize, richTextRuns,
AIgnoreCompressedFlag);
end;
function TBIFFGrid.GetStringType: String;
begin
@ -1505,6 +1575,7 @@ begin
'(relict of BIFF5)');
end else begin
ExtractString(FBufferIndex, 2, true, s, numBytes);
if Row = FCurrRow then begin
FDetails.Add('Encoded URL without sheet name:'#13);
case s[1] of
@ -4154,7 +4225,12 @@ var
numBytes: Integer;
s: String;
total1, total2: DWord;
i: Integer;
i, j: Integer;
asianPhoneticBlockOffset: Integer;
asianPhoneticBlockSize: DWord;
richTextRuns: TRichTextRuns;
dw: DWord;
b: Byte;
begin
numBytes := 4;
Move(FBuffer[FBufferIndex], total1, numBytes);
@ -4170,9 +4246,47 @@ begin
'Number of following strings');
for i:=1 to total2 do begin
ExtractString(FBufferIndex, 2, true, s, numBytes);
ExtractString(FBufferIndex, 2, true, s, numBytes, asianPhoneticBlockOffset,
asianPhoneticBlockSize, richTextRuns);
if FFormat = sfExcel8 then begin
if Row = FCurrRow then begin
FDetails.Add('Wide string info:'#13);
FDetails.Add('2 length bytes: ' + IntToStr(UTF8Length(s)));
b := FBuffer[FBufferIndex+2];
FDetails.Add('Options byte: ' + IntToStr(b));
if b and $01 = 0
then FDetails.Add(' Bit 1 = 0: compressed characters (8-bit characters)')
else FDetails.Add(' Bit 1 = 1: uncompressed characters (16-bit characters)');
if b and $04 = 0
then FDetails.Add(' Bit 4 = 0: Does not contain Asian phonetic settings')
else FDetails.Add(' Bit 4 = 1: Contains Asian phonetic settings');
if b and $08 = 0
then FDetails.Add(' Bit 8 = 0: Does not contain Rich-Text settings')
else FDetails.Add(' Bit 8 = 1: Contains Rich-Text settings');
if Length(richTextRuns) > 0 then begin
FDetails.Add('Rich-Text information (2 bytes):');
FDetails.Add(' ' +IntToStr(Length(richTextRuns)) + ' Rich-Text runs');
end;
if asianPhoneticBlockSize > 0 then begin
FDetails.Add('Asian phonetic block size information (4 bytes): ');
FDetails.Add(' Block size: ' + IntToStr(AsianPhoneticBlockSize) + ' bytes');
end;
FDetails.Add('String text: ' + s);
if Length(richTextRuns)>0 then begin
FDetails.Add('Rich text runs:');
for j:=0 to High(richTextRuns) do
FDetails.Add(Format(' Rich text run #%d: binary data $%.4x --> index of first formatted character %d, font index %d',
[j, DWord(richTextRuns[j]), richTextRuns[j].IndexToFirstChar, richTextRuns[j].FontIndex]));
end;
if asianPhoneticBlockSize>0 then begin
FDetails.Add('Asian phonetic block:');
FDetails.Add(' Size: ' + IntToStr(asianPhoneticBlockSize));
FDetails.Add(' (not decoded)');
end;
end;
ShowInRow(FCurrRow, FBufferIndex, numBytes, s, Format('Shared string #%d', [i]));
end;
end;
end;

20
components/fpspreadsheet/xlsbiff8.pas
View File

@ -1264,15 +1264,16 @@ var
begin
StringFlags:=AStream.ReadByte;
Dec(PendingRecordSize);
if StringFlags and 4 = 4 then begin
//Asian phonetics
//Read Asian phonetics Length (not used)
AsianPhoneticBytes:=DWordLEtoN(AStream.ReadDWord);
end;
if StringFlags and 8 = 8 then begin
//Rich string
RunsCounter:=WordLEtoN(AStream.ReadWord);
dec(PendingRecordSize,2);
dec(PendingRecordSize, 2);
end;
if StringFlags and 4 = 4 then begin
//Asian phonetics
//Read Asian phonetics length (not used)
AsianPhoneticBytes:=DWordLEtoN(AStream.ReadDWord);
dec(PendingRecordSize, 4);
end;
if StringFlags and 1 = 1 Then begin
//String is WideStringLE
@ -1297,7 +1298,7 @@ begin
DecomprStrValue[i] := C;
Dec(PendingRecordSize);
if (PendingRecordSize<=0) and (i<lLen) then begin
//A CONTINUE may happend here
//A CONTINUE may happen here
RecordType := WordLEToN(AStream.ReadWord);
RecordSize := WordLEToN(AStream.ReadWord);
if RecordType<>INT_EXCEL_ID_CONTINUE then begin
@ -1309,14 +1310,13 @@ begin
end;
end;
end;
Result := DecomprStrValue;
end;
if StringFlags and 8 = 8 then begin
//Rich string (This only happened in BIFF8)
//Rich string (This only happens in BIFF8)
for j := 1 to RunsCounter do begin
if (PendingRecordSize<=0) then begin
//A CONTINUE may happend here
//A CONTINUE may happen here
RecordType := WordLEToN(AStream.ReadWord);
RecordSize := WordLEToN(AStream.ReadWord);
if RecordType<>INT_EXCEL_ID_CONTINUE then begin