home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kolekce / d567 / FLEXCEL.ZIP / XLSAdapter / UXlsStrings.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-05  |  6.1 KB  |  230 lines

  1. unit UXlsStrings;
  2.  
  3. interface
  4. uses XlsMessages, SysUtils, Classes, UXlsBaseRecords;
  5. type
  6.   TStrLenLength= 1..2;
  7.   TCharSize=1..2;
  8.  
  9.   TExcelString= class
  10.   private
  11.     // Common data
  12.     StrLenLength: TStrLenLength;  //this stores if it's a one or two bytes length
  13.     StrLen: word;
  14.     OptionFlags: byte;
  15.     WideData: WideString;
  16.     ShortData: string;
  17.  
  18.     //Rich text
  19.     NumberRichTextFormats: word;
  20.     RichTextFormats: PArrayOfByte;
  21.  
  22.     //FarEast
  23.     FarEastDataSize: Cardinal;
  24.     FarEastData: PArrayOfByte;
  25.     function GetValue: WideString;
  26.  
  27.   public
  28.     constructor Create(const aStrLenLength: TStrLenLength; var aRecord: TBaseRecord; var Ofs: integer);overload;
  29.     constructor Create(const aStrLenLength: TStrLenLength;const s: wideString); overload;
  30.  
  31.     destructor Destroy;override;
  32.  
  33.     procedure SaveToStream(const DataStream: TStream);
  34.  
  35.     function GetCharSize: TCharSize;
  36.     function HasRichText: boolean;
  37.     function HasFarInfo: boolean;
  38.  
  39.     function Compare(const Str2: TExcelString): integer; //-1 if less, 0 if equal, 1 if more
  40.     function TotalSize: int64;
  41.  
  42.     procedure CopyToPtr(const Ptr: PArrayOfByte; const aPos: integer);
  43.     property Value: WideString read GetValue;
  44.   end;
  45.  
  46. implementation
  47.  
  48. { TExcelString }
  49.  
  50. function MyWideCompareStr(const S1, S2: WideString): Integer;
  51. var
  52.   i:integer;
  53. begin
  54.   Result:=0;
  55.   if Length(S1)<Length(S2) then Result:=-1 else if Length(S1)>Length(S2) then Result:=1
  56.   else
  57.   for i:=1 to Length(S1) do
  58.   begin
  59.     if S1[i]=S2[i] then continue
  60.     else if S1[i]<S2[i] then Result:=-1 else Result:=1;
  61.     exit;
  62.   end;
  63. end;
  64.  
  65.  
  66. constructor TExcelString.Create(const aStrLenLength: TStrLenLength; var aRecord: TBaseRecord; var Ofs: integer);
  67. var
  68.   StrLenByte: byte;
  69.   DestPos: integer;
  70.   ActualOptionFlags: byte;
  71. begin
  72.   inherited Create;
  73.   StrLenLength:=aStrLenLength;
  74.   if StrLenLength=1 then
  75.   begin
  76.     ReadMem(aRecord, Ofs, StrLenLength, @StrLenByte);
  77.     StrLen:=StrLenByte;
  78.   end
  79.   else ReadMem(aRecord, Ofs, StrLenLength, @StrLen);
  80.  
  81.   ReadMem(aRecord, Ofs, SizeOf(OptionFlags), @OptionFlags);
  82.   ActualOptionFlags:=OptionFlags;
  83.  
  84.   if HasRichText then ReadMem(aRecord, Ofs, SizeOf(NumberRichTextFormats), @NumberRichTextFormats)
  85.   else NumberRichTextFormats:=0;
  86.  
  87.   if HasFarInfo then ReadMem(aRecord, Ofs, SizeOf(FarEastDataSize), @FarEastDataSize)
  88.   else FarEastDataSize:=0;
  89.  
  90.   DestPos:=0;
  91.   SetLength( ShortData, StrLen);
  92.   SetLength( WideData, StrLen);
  93.   ReadStr(aRecord, Ofs, ShortData, WideData, OptionFlags, ActualOptionFlags, DestPos, StrLen);
  94.   if GetCharSize=1 then WideData:='' else ShortData:='';
  95.  
  96.   if NumberRichTextFormats>0 then
  97.   begin
  98.     GetMem(RichTextFormats, 4* NumberRichTextFormats);
  99.     ReadMem(aRecord, Ofs, 4* NumberRichTextFormats, RichTextFormats)
  100.   end;
  101.  
  102.   if FarEastDataSize>0 then
  103.   begin
  104.     GetMem(FarEastData, FarEastDataSize);
  105.     ReadMem(aRecord, Ofs, FarEastDataSize, FarEastData)
  106.   end;
  107.  
  108. end;
  109.  
  110. function TExcelString.Compare(const Str2: TExcelString): integer;
  111. begin
  112.   if StrLenLength< Str2.StrLenLength then begin;Result:=-1;exit; end
  113.   else if StrLenLength> Str2.StrLenLength then begin;Result:=1;exit; end;
  114.  
  115.   if OptionFlags< Str2.OptionFlags then begin; Result:=-1; exit; end
  116.   else if OptionFlags> Str2.OptionFlags then begin; Result:=1; exit; end;
  117.  
  118.   if GetCharSize=1 then Result:=CompareStr(ShortData, Str2.ShortData) else
  119.   Result:= MyWideCompareStr(WideData, Str2.WideData);
  120. end;
  121.  
  122. constructor TExcelString.Create(const aStrLenLength: TStrLenLength;
  123.   const s: wideString);
  124. begin
  125.   inherited Create;
  126.   StrLenLength:=aStrLenLength;
  127.   case StrLenLength of
  128.     1: if Length(s)> $FF then raise Exception.Create(ErrInvalidStringRecord);
  129.   end; //case
  130.   StrLen:=Length(s);
  131.  
  132.   OptionFlags:=0;
  133.   if IsWide(s) then OptionFlags:=1;
  134.   NumberRichTextFormats:=0;
  135.   FarEastDataSize:=0;
  136.  
  137.   if GetCharSize= 1 then ShortData:=WideStringToStringNoCodePage(s) else WideData:=s;
  138. end;
  139.  
  140. destructor TExcelString.Destroy;
  141. begin
  142.   FreeMem(FarEastData);
  143.   FreeMem(RichTextFormats);
  144.   inherited;
  145. end;
  146.  
  147. function TExcelString.GetCharSize: TCharSize;
  148. begin
  149.   if OptionFlags and $1 = 0 then Result:=1 else Result:=2;
  150. end;
  151.  
  152. function TExcelString.HasFarInfo: boolean;
  153. begin
  154.   Result:= OptionFlags and $4 = $4;
  155. end;
  156.  
  157. function TExcelString.HasRichText: boolean;
  158. begin
  159.   Result:= OptionFlags and $8 = $8;
  160. end;
  161.  
  162. function TExcelString.TotalSize: int64;
  163. begin
  164.   Result:=
  165.     StrLenLength+
  166.     SizeOf(OptionFlags)+
  167.     StrLen* GetCharSize;
  168.  
  169.     //Rich text
  170.     if HasRichText then
  171.       Result:=Result + SizeOf(NumberRichTextFormats)+ 4* NumberRichTextFormats;
  172.  
  173.     //FarEast
  174.     if HasFarInfo then
  175.       Result:=Result+ SizeOf(FarEastDataSize) + FarEastDataSize;
  176. end;
  177.  
  178. procedure TExcelString.SaveToStream(const DataStream: TStream);
  179.  
  180. begin
  181.   case StrLenLength of
  182.     1: DataStream.Write(StrLen, SizeOf(Byte));
  183.     2: DataStream.Write(StrLen, SizeOf(Word));
  184.     else raise Exception.Create(ErrInvalidStrLenLength);
  185.   end; //case
  186.  
  187.   DataStream.Write(OptionFlags, SizeOf(OptionFlags));
  188.  
  189.   if HasRichText then
  190.     DataStream.Write(NumberRichTextFormats, SizeOf(NumberRichTextFormats));
  191.  
  192.   if HasFarInfo then
  193.     DataStream.Write(FarEastDataSize, SizeOf(FarEastDataSize));
  194.  
  195.   if GetCharSize= 1 then
  196.     if StrLen>0 then DataStream.Write(ShortData[1], Length(ShortData)) else //nothing
  197.   else
  198.     if StrLen>0 then DataStream.Write(WideData[1], Length(WideData)* SizeOf(WideChar));
  199.  
  200.   if NumberRichTextFormats>0 then
  201.     DataStream.Write(RichTextFormats^, 4*NumberRichTextFormats);
  202.  
  203.   if FarEastDataSize>0 then
  204.     DataStream.Write(FarEastData^, FarEastDataSize);
  205.  
  206. end;
  207.  
  208. procedure TExcelString.CopyToPtr(const Ptr: PArrayOfByte;
  209.   const aPos: integer);
  210. var
  211.   Ms: TMemoryStream;
  212. begin
  213.   //Not the most efficient... but this way we avoid duplicating code 
  214.   Ms:= TMemoryStream.Create;
  215.   try
  216.     SaveToStream(Ms);
  217.     Ms.Position:=0;
  218.     Ms.Read(Ptr[aPos], Ms.Size);
  219.   finally
  220.     FreeAndNil(Ms);
  221.   end;
  222. end;
  223.  
  224. function TExcelString.GetValue: WideString;
  225. begin
  226.   if GetCharSize=1 then Result:= StringToWideStringNoCodePage(ShortData) else Result:= WideData;
  227. end;
  228.  
  229. end.
  230.