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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3504 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/excel8demo/excel8read.lpi

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

components/fpspreadsheet/examples/excel8demo/excel8read.lpr

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

components/fpspreadsheet/reference/BIFFExplorer/BIFFExplorer.lpi

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

components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas

@@ -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;
+  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)
+    if (optn and $01 = 0) and (not AIgnoreCompressedFlag) then
-    then begin   // compressed --> 1 byte per character
+      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], sa[1], ls*SizeOf(AnsiChar));
-      Move(FBuffer[ABufIndex + ALenBytes + 1], sa[1], ls*SizeOf(AnsiChar));
+      inc(ABufIndex, ls*SizeOf(AnsiChar));
-      AString := sa;
+      AString := AnsiToUTF8(sa);
     end else begin
       SetLength(sw, ls);
-      ANumBytes := ls*SizeOf(WideChar) + ALenBytes + 1;
+      Move(FBuffer[ABufIndex], sw[1], ls*SizeOf(WideChar));
-      Move(FBuffer[ABufIndex + ALenBytes + 1], 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;
 
 

components/fpspreadsheet/xlsbiff8.pas

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