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

Starts improving the xls biff 8 codepage support, doesnt actually work yet

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2194 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-12-24 23:38:24 +00:00
parent ab2b63d534
commit f8caf9447a
3 changed files with 118 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -1,10 +1,11 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="laz_fpspreadsheet"/>
<AddToProjectUsesSection Value="True"/>
<CompilerOptions>
<Version Value="10"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
@ -16,7 +17,7 @@
</Parsing>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<DebugInfoType Value="dsStabs"/>
</Debugging>
</Linking>
<Other>
@ -105,11 +106,14 @@
</Item19>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="1">
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LazUtils"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item1>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>

58
components/fpspreadsheet/xlsbiff8.pas
View File

@ -59,7 +59,7 @@ uses
{$else}
fpolestorage,
{$endif}
fpsutils;
fpsutils, lazutf8;
type
@ -87,6 +87,7 @@ type
procedure ReadRichString(const AStream: TStream);
procedure ReadSST(const AStream: TStream);
procedure ReadLabelSST(const AStream: TStream);
procedure ReadFont(const AStream: TStream);
public
{ General reading methods }
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override;
@ -158,6 +159,7 @@ const
INT_EXCEL_ID_CONTINUE = $003C;
INT_EXCEL_ID_LABELSST = $00FD; //BIFF8 only
INT_EXCEL_ID_PALETTE = $0092;
INT_EXCEL_ID_CODEPAGE = $0042;
{ Cell Addresses constants }
MASK_EXCEL_ROW = $3FFF;
@ -1424,6 +1426,8 @@ begin
INT_EXCEL_ID_BOUNDSHEET: ReadBoundSheet(AStream);
INT_EXCEL_ID_EOF: SectionEOF := True;
INT_EXCEL_ID_SST: ReadSST(AStream);
INT_EXCEL_ID_CODEPAGE: ReadCodepage(AStream);
INT_EXCEL_ID_FONT: ReadFont(AStream);
else
// nothing
end;
@ -1600,7 +1604,7 @@ end;
function TsSpreadBIFF8Reader.ReadString(const AStream: TStream;
const ALength: WORD): UTF8String;
begin
Result:=UTF8Encode(ReadWideString(AStream, ALength));
Result:=UTF16ToUTF8(ReadWideString(AStream, ALength));
end;
procedure TsSpreadBIFF8Reader.ReadFromFile(AFileName: string; AData: TsWorkbook);
@ -1697,7 +1701,7 @@ begin
WideStrValue:=ReadWideString(AStream,L);
{ Save the data }
FWorksheet.WriteUTF8Text(ARow, ACol, UTF8Encode(WideStrValue));
FWorksheet.WriteUTF8Text(ARow, ACol, UTF16ToUTF8(WideStrValue));
end;
procedure TsSpreadBIFF8Reader.ReadNumber(AStream: TStream);
@ -1789,13 +1793,16 @@ begin
Raise Exception.Create('Expected CONTINUE not found.');
end;
PendingRecordSize:=WordLEtoN(AStream.ReadWord);
Dec(StringLength,Length(UTF8Decode(LString))); //Dec the used chars
Dec(StringLength,Length(UTF8ToUTF16(LString))); //Dec the used chars
if StringLength=0 then break;
end else begin
break;
end;
end;
FSharedStringTable.Add(LString);
{$ifdef XLSDEBUG}
WriteLn('Adding shared string: ' + LString);
{$endif}
dec(Items);
end;
end;
@ -1813,6 +1820,49 @@ begin
FWorksheet.WriteUTF8Text(ARow, ACol, FSharedStringTable[SSTIndex]);
end;
procedure TsSpreadBIFF8Reader.ReadFont(const AStream: TStream);
var
lCodePage: Word;
lHeight: Word;
lOptions: Word;
Len: Byte;
lFontName: UTF8String;
begin
{ Height of the font in twips = 1/20 of a point }
lHeight := AStream.ReadWord(); // WordToLE(200)
{ Option flags }
lOptions := AStream.ReadWord();
{ Colour index }
AStream.ReadWord();
{ Font weight }
AStream.ReadWord();
{ Escapement type }
AStream.ReadWord();
{ Underline type }
AStream.ReadByte();
{ Font family }
AStream.ReadByte();
{ Character set }
lCodepage := AStream.ReadByte();
{$ifdef XLSDEBUG}
WriteLn('Reading Font Codepage='+IntToStr(lCodepage));
{$endif}
{ Not used }
AStream.ReadByte();
{ Font name: Unicodestring, char count in 1 byte }
Len := AStream.ReadByte();
lFontName := ReadString(AStream, Len);
end;
{*******************************************************************
* Initialization section
*

56
components/fpspreadsheet/xlscommon.pas
View File

@ -9,7 +9,7 @@ interface
uses
Classes, SysUtils,
fpspreadsheet,
fpsutils;
fpsutils{, lconvencoding};
const
{ Formula constants TokenID values }
@ -85,6 +85,8 @@ type
TsSpreadBIFFReader = class(TsCustomSpreadReader)
protected
FCodepage: string;
procedure ReadCodePage(AStream: TStream);
end;
{ TsSpreadBIFFWriter }
@ -103,6 +105,58 @@ type
implementation
{ TsSpreadBIFFReader }
procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream);
var
lCodePage: Word;
begin
{ Codepage }
lCodePage := WordLEToN(AStream.ReadWord());
case lCodePage of
// 016FH = 367 = ASCII
// 01B5H = 437 = IBM PC CP-437 (US)
//02D0H = 720 = IBM PC CP-720 (OEM Arabic)
//02E1H = 737 = IBM PC CP-737 (Greek)
//0307H = 775 = IBM PC CP-775 (Baltic)
//0352H = 850 = IBM PC CP-850 (Latin I)
//0354H = 852 = IBM PC CP-852 (Latin II (Central European))
//0357H = 855 = IBM PC CP-855 (Cyrillic)
//0359H = 857 = IBM PC CP-857 (Turkish)
$0359: FCodepage := 'cp857';
{035AH = 858 = IBM PC CP-858 (Multilingual Latin I with Euro)
035CH = 860 = IBM PC CP-860 (Portuguese)
035DH = 861 = IBM PC CP-861 (Icelandic)
035EH = 862 = IBM PC CP-862 (Hebrew)
035FH = 863 = IBM PC CP-863 (Canadian (French))
0360H = 864 = IBM PC CP-864 (Arabic)
0361H = 865 = IBM PC CP-865 (Nordic)
0362H = 866 = IBM PC CP-866 (Cyrillic (Russian))
0365H = 869 = IBM PC CP-869 (Greek (Modern))
036AH = 874 = Windows CP-874 (Thai)
03A4H = 932 = Windows CP-932 (Japanese Shift-JIS)
03A8H = 936 = Windows CP-936 (Chinese Simplified GBK)
03B5H = 949 = Windows CP-949 (Korean (Wansung))
03B6H = 950 = Windows CP-950 (Chinese Traditional BIG5)
04B0H = 1200 = UTF-16 (BIFF8)
04E2H = 1250 = Windows CP-1250 (Latin II) (Central European)
04E3H = 1251 = Windows CP-1251 (Cyrillic)
04E4H = 1252 = Windows CP-1252 (Latin I) (BIFF4-BIFF5)
04E5H = 1253 = Windows CP-1253 (Greek)}
//04E6H = 1254 = Windows CP-1254 (Turkish)
$04E6: FCodepage := 'cp1254';
{04E7H = 1255 = Windows CP-1255 (Hebrew)
04E8H = 1256 = Windows CP-1256 (Arabic)
04E9H = 1257 = Windows CP-1257 (Baltic)
04EAH = 1258 = Windows CP-1258 (Vietnamese)
0551H = 1361 = Windows CP-1361 (Korean (Johab))
2710H = 10000 = Apple Roman
8000H = 32768 = Apple Roman
8001H = 32769 = Windows CP-1252 (Latin I) (BIFF2-BIFF3)}
end;
end;
function TsSpreadBIFFWriter.FPSColorToEXCELPallete(AColor: TsColor): Word;
begin
case AColor of