uxlssst.pas

来自「DELPHI界面增强控件,非常好,里面有显示GIF的图片控件,更美观的下拉框控件」· PAS 代码 · 共 613 行 · 第 1/2 页

  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: Cardinal;
  RecordHeader: TRecordHeader;
  BeginRecordPos: Cardinal;
  First, Last: integer;
  Se: PiSSTEntry;
begin
  BeginRecordPos:=DataStream.Position;
  RecordHeader.Id:= xlr_SST;

  //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+Cardinal(SSTRefs(Se));
    inc(i);
   end;


  First:=0;
  RecordHeader.Size:=8;
  CalcNextContinue(First, Last, RecordHeader.Size);

  DataStream.Write(RecordHeader, SizeOf(RecordHeader));
  DataStream.Write(TotalRefs, SizeOf(TotalRefs));
  aCount:=Count;
  DataStream.Write(aCount, Sizeof(aCount));

  while First<Count do
  begin
    for i:= First to Last-1 do
    begin
      SaveSSTToStream(@MemSST.Buffer[Items[i]], DataStream, BeginRecordPos);
    end;

    //Write continue
    First:=Last;
    if First<Count then
    begin
      BeginRecordPos:= DataStream.Position;
      RecordHeader.Id:= xlr_CONTINUE;
      RecordHeader.Size:=0;
      CalcNextContinue(First, Last, RecordHeader.Size);
      DataStream.Write(RecordHeader, SizeOf(RecordHeader));
    end;
  end;

  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;
end;

function TSST.SSTRecordSize: int64;
//Has to handle continue records
var
  First, Last: integer;
  Rs: Word;
begin
  Result:=8;
  Rs:=0;
  First:=0;
  while First<Count do
  begin
    CalcNextContinue(First,Last, Rs);
    First:=Last;
    Result:=Result+Rs;
    if Last< Count then Result:=Result+SizeOf(TRecordHeader);
    Rs:=0;
  end;
end;


function TSST.TotalSize: int64;
begin
  Result:= SSTRecordSize + ExtSSTRecordSize + 2* SizeOf(TRecordHeader);
end;

procedure TSST.CalcNextContinue(const First: integer; var Last: integer; var RecordSize: word);
var
 RSize: integer;
begin
  Last:=First;
  if Last<Count then RSize:=SSTRealLength(@MemSST.Buffer[Items[Last]]) else RSize:=0;
  while (Last<Count) and (RecordSize+ RSize< MaxRecordDataSize) do
  begin
    inc(RecordSize, RSize);
    inc(Last);
    if Last<Count then RSize:=SSTRealLength(@MemSST.Buffer[Items[Last]]);
  end;
  if (First=Last) and (Last<Count) then raise Exception.Create(ErrStringTooLarge);
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:=GetCardinal(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
  SetCardinal(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;
begin
  Result:=GetSSTValue(SST.GetEntry(pSSTEntry));
end;

procedure TLabelSSTRecord.SetAsString(const Value: WideString);
var
  OldpSSTEntry: TiSSTEntry;
begin
  OldpSSTEntry:=pSSTEntry;
  pSSTEntry:= SST[SST.AddString(Value)];
  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;


{ 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.