uxlssst.pas

TMS Component Pack Pro v4.2

      end;
    end;
  end;

  inc(p, aLen*CharSize);

  if  OptionFlags and $8 = $8 then //HasRichText then
  begin
     Data:= PArrayOfByte(@Entry[p+SizeOf(TExtraData)]);
     WriteArray(Data, RTFRuns*4, DataStream, Buffer, BufferPos, BeginRecordPos, TotalSize);
     p:=p+RTFRuns*4;
  end;

  if OptionFlags and $4 = $4 then //HasFarInfo then
  begin
     Data:= PArrayOfByte(@Entry[p+SizeOf(TExtraData)]);
     WriteArray(Data, FarEastLen, DataStream, Buffer, BufferPos, BeginRecordPos, TotalSize);
  end;

end;

function GetSSTValue(const Entry: PiSSTEntry; var RTFRunList: TRTFRunList): widestring;
var
  OptionFlags: byte;
  Ini: integer;
  RTFRunCount: integer;
  i: integer;
  St: string;
begin
    OptionFlags:=Entry[2+SizeOf(TExtraData)];
    Ini:=SizeOf(TExtraData)+
            2+ //Length
            SizeOf(OptionFlags);

    //Rich text
    RTFRunCount:=0;
    if OptionFlags and $8 = $8 {HasRichText} then
    begin
      RTFRunCount:=GetWord(Entry, Ini);
      Inc(Ini, 2);
    end;

    //FarEast
    if OptionFlags and $4 = $4 {HasFarInfo} then
      Inc(Ini, 4);

    if OptionFlags and $1 = 0 then
    begin
      SetLength(St, GetWord(Entry, SizeOf(TExtraData)));
      Move(Entry[Ini], St[1], Length(St));
      Inc(Ini, Length(St));
      Result:=StringToWideStringNoCodePage(St);
    end else
    begin
      SetLength(Result, GetWord(Entry, SizeOf(TExtraData)));
      Move(Entry[Ini], Result[1], Length(Result)*2);
      Inc(Ini, Length(Result)*2);
    end;

    SetLength(RTFRunList, RTFRunCount);
    for i:=0 to RTFRunCount-1 do
    begin
      RTFRunList[i].FirstChar:=GetWord(Entry, Ini);
      RTFRunList[i].FontIndex:=GetWord(Entry, Ini+2);
      inc(Ini,4);
    end;
end;

//**************************************************************
{ TSST }
function TSST.AddString(const s: Widestring; const RTFRuns: TRTFRunList): integer;
var
  es: TiSSTEntry;
  pEs: PiSSTEntry;
  LastMem: integer;
begin
  LastMem:=MemSST.UsedSize;
  CreateSSTEntryFromString(MemSST, s, RTFRuns, es);
  try
    pEs:=@MemSST.Buffer[es];
    if Find(pEs, Result) then
    begin
      AddSSTRef(@MemSST.Buffer[Items[Result]]);
      MemSST.UsedSize:=LastMem; //No need to add space.
    end else
    begin
      Insert(Result, es);
      AddSSTRef(pEs);
      //es:=nil;  //so we dont free it
    end;
  finally
    //No need to free. if es<>nil then Freemem(es);
  end;
end;

function TSST.Find(const S: PiSSTEntry; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := CompareSSTEntry(@MemSST.Buffer[Items[I]],S);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        L := I;
      end;
    end;
  end;
  Index := L;
end;

procedure TSST.Load(const aSSTRecord: TSSTRecord);
var
  i, Ofs:integer;
  Es: TiSSTEntry;
  TmpSSTRecord: TBaseRecord;
begin
  Ofs:=8;
  TmpSSTRecord:= aSSTRecord;
  for i:=0 to aSSTRecord.Count-1 do
  begin
    CreateSSTEntryFromRecord(MemSST, TmpSSTRecord, Ofs, Es);
    try
      Add(Es);
      //Es:=nil;
    finally
      //No need to free. if es<>nil then Freemem(Es);
    end; //Finally
  end;
  //We can't sort now, this should be done after all the LABELSST records have been loaded
end;

procedure TSST.FixRefs;
var
  i: integer;
begin
  for i:=count-1 downto 0 do
    if SSTRefs(@MemSST.Buffer[Items[i]])<=0 then Delete(i);
end;

procedure TSST.SaveToStream(const DataStream: TStream);
var
  i:integer;
  TotalRefs, aCount: LongWord;
  BeginRecordPos: LongWord;
  Se: PiSSTEntry;
  Buffer: TRecordBuff;
  BufferPos: integer;
  TotalSize: int64;
  w:word;
begin
  BeginRecordPos:=DataStream.Position;
  w:=xlr_SST;
  System.move(w, Buffer[0], 2);

  //Renum the items
  i:=0; TotalRefs:=0;
  while i< Count do
  begin
    Se:=@MemSST.Buffer[Items[i]];
    Assert(SSTRefs(Se)>0,'Refs should be >0');
    PExtraData(Se).PosInTable:=i;
    TotalRefs:=TotalRefs+LongWord(SSTRefs(Se));
    inc(i);
   end;

  System.move(TotalRefs, Buffer[4], 4);
  aCount:=Count;
  System.move(aCount, Buffer[8], 4);


  BufferPos:=4+8;
  TotalSize:=0;

  for i:= 0 to Count-1 do
  begin
    SaveSSTToStream(@MemSST.Buffer[Items[i]], DataStream, BeginRecordPos, Buffer, BufferPos, TotalSize);
  end;

  //Flush the buffer.
  SetWord(PArrayOfByte(@Buffer), 2, BufferPos - 4);  //Adapt the record size before writing it.
  DataStream.Write(Buffer, BufferPos);

  WriteExtSST(DataStream);
end;

procedure TSST.WriteExtSST(const DataStream: TStream);
var
  n, nBuckets, Dummy: Word;
  i: integer;
  RecordHeader: TRecordHeader;
begin
  // Calc number of strings per hash bucket
  n:=Count div 128+1;
  if n<8 then n:=8;

  if Count=0 then nBuckets:=0 else nBuckets:= (Count-1) div n + 1;

  RecordHeader.Id:= xlr_EXTSST;
  RecordHeader.Size:= 2+8*nBuckets;
  DataStream.Write(RecordHeader, SizeOf(RecordHeader));
  DataStream.Write(n, SizeOf(n));
  i:= 0; Dummy:=0;
  while i<Count do
  begin
    DataStream.Write(PExtraData(@MemSST.Buffer[Items[i]]).AbsStreamPos, SizeOf(PExtraData(nil).AbsStreamPos));
    DataStream.Write(PExtraData(@MemSST.Buffer[Items[i]]).RecordStreamPos, SizeOf(PExtraData(nil).RecordStreamPos));
    DataStream.Write(Dummy, SizeOf(Dummy));
    inc(i,n);
  end;

end;


procedure TSST.QuickSort(L, R: Integer);
var
  I, J: Integer;
  P, T: Pointer;
begin
  repeat
    I := L;
    J := R;
    P := @MemSST.Buffer[Items[(L + R) shr 1]];
    repeat
      while CompareSSTEntries(@MemSST.Buffer[Items[I]], P) < 0 do
        Inc(I);
      while CompareSSTEntries(@MemSST.Buffer[Items[J]], P) > 0 do
        Dec(J);
      if I <= J then
      begin
        T := inherited Items[I];
        inherited Items[I] := inherited Items[J];
        inherited Items[J] := T;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J);
    L := I;
  until I >= R;
end;

procedure TSST.Sort;
begin
  if (Count > 0) then
    QuickSort(0, Count - 1);
end;

function TSST.ExtSSTRecordSize: int64;
var
  n, nBuckets: word;
begin
  n:=Count div 128+1;
  if n<8 then n:=8;

  if Count=0 then nBuckets:=0 else nBuckets:= (Count-1) div n + 1;
  Result:= 2+8*nBuckets+SizeOf(TRecordHeader);
end;

//Simulates a write to know how much it takes.
function TSST.SSTRecordSize: int64;
//Has to handle continue records
var
  BeginRecordPos:LongWord;
  Buffer: TRecordBuff;
  BufferPos: integer;
  TotalSize: int64;
  i: integer;
begin
  BeginRecordPos:=0;
  BufferPos:=4+8;
  TotalSize:=0;
  for i:=0 to Count-1 do
  begin
    SaveSSTToStream(@MemSST.Buffer[Items[i]], nil, BeginRecordPos, Buffer, BufferPos, TotalSize);
  end;

  Result:=TotalSize+BufferPos;
end;


function TSST.TotalSize: int64;
begin
  Result:= SSTRecordSize + ExtSSTRecordSize;
end;

constructor TSST.Create;
begin
  inherited;
  MemSST.UsedSize:=0;
  SetLength(MemSST.Buffer, MemSSTDeltaSize);
end;

function TSST.GetEntry(const aEntry: TiSSTEntry): PiSSTEntry;
begin
  Result:=@MemSST.Buffer[aEntry];
end;

{ TLabelSSTRecord }

constructor TLabelSSTRecord.Create(const aId: word;
  const aData: PArrayOfByte; const aDataSize: integer);
begin
  inherited Create(aId, aData, aDataSize);
end;

procedure TLabelSSTRecord.AttachToSST(const aSST: TSST);
var
  a:int64;
begin
  SST:=aSST;
  a:=GetLongWord(Data,6);
  if a> SST.Count then raise Exception.Create(ErrExcelInvalid);
  pSSTEntry:= SST[a];
  AddSSTRef(SST.GetEntry(pSSTEntry));
end;

destructor TLabelSSTRecord.Destroy;
begin
  if pSSTEntry>=0 then DecSSTRef(SST.GetEntry(pSSTEntry));
  inherited;
end;

procedure TLabelSSTRecord.SaveToStream(const Workbook: TStream);
begin
  SetLongWord(Data, 6, PExtraData(SST.GetEntry(pSSTEntry)).PosInTable);
  inherited;
end;

function TLabelSSTRecord.DoCopyTo: TBaseRecord;
begin
  Result:= inherited DoCopyTo;
  (Result as TLabelSSTRecord).SST:= SST;
  (Result as TLabelSSTRecord).pSSTEntry:= pSSTEntry;
  AddSSTRef(SST.GetEntry((Result as TLabelSSTRecord).pSSTEntry));

end;

function TLabelSSTRecord.GetValue: Variant;
begin
  Result:=GetAsString;
end;

procedure TLabelSSTRecord.SetValue(const Value: Variant);
begin
  SetAsString(Value);
end;

function TLabelSSTRecord.GetAsString: WideString;
var
  RTFRuns: TRTFRunList;
begin
  Result:=GetSSTValue(SST.GetEntry(pSSTEntry), RTFRuns);
end;

procedure TLabelSSTRecord.SetAsString(const Value: WideString);
var
  OldpSSTEntry: TiSSTEntry;
begin
  OldpSSTEntry:=pSSTEntry;
  pSSTEntry:= SST[SST.AddString(Value, nil)];
  if OldpSSTEntry>=0 then DecSSTRef(SST.GetEntry(OldpSSTEntry));
end;

function TLabelSSTRecord.GetAsRichString: TRichString;
begin
  Result.Value:=GetSSTValue(SST.GetEntry(pSSTEntry), Result.RTFRuns);
end;

procedure TLabelSSTRecord.SetAsRichString(const Value: TRichString);
var
  OldpSSTEntry: TiSSTEntry;
begin
  OldpSSTEntry:=pSSTEntry;
  pSSTEntry:= SST[SST.AddString(Value.Value, Value.RTFRuns)];
  if OldpSSTEntry>=0 then DecSSTRef(SST.GetEntry(OldpSSTEntry));
end;

constructor TLabelSSTRecord.CreateFromData(const aRow, aCol, aXF: word; const aSST: TSST);
begin
  inherited CreateFromData(xlr_LABELSST, 10, aRow, aCol, aXF);
  SST:=aSST;
  pSSTEntry:=-1;
end;


function TLabelSSTRecord.GetAsRTF: WideString;
begin
  //Todo:
end;

procedure TLabelSSTRecord.SetAsRTF(const Value: WideString);
//var
//  OldpSSTEntry: TiSSTEntry;
begin
{TODO:
  OldpSSTEntry:=pSSTEntry;
  pSSTEntry:= SST[SST.AddString(Value)];
  if OldpSSTEntry>=0 then DecSSTRef(SST.GetEntry(OldpSSTEntry));
}
end;


{ TLabelRecord }

function TLabelRecord.GetValue: Variant;
var
  XS: TExcelString;
  MySelf: TBaseRecord;
  MyOfs: integer;
begin
  MySelf:=Self;
  MyOfs:=6;
  XS:=TExcelString.Create(2, Myself, MyOfs);
  try
    Result:= XS.Value;
  finally
    FreeAndNil(XS);
  end;
end;

end.