xlsfile3.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

  inherited Items[Index] := Value;
end;

function TbiffColRowList.Add(Item: TbiffColRow): integer;
begin
  Result := inherited Add(Item);
end;

procedure TbiffColRowList.Insert(Index: integer; Item: TbiffColRow);
begin
  inherited Insert(Index, Item);
end;

{ TbiffCellList }

function TbiffCellList.GetItems(Index: integer): TbiffCell;
begin
  Result := TbiffCell(inherited Items[Index]);
end;

procedure TbiffCellList.SetItems(Index: integer; Value: TbiffCell);
begin
  inherited Items[Index] := Value;
end;

procedure TbiffCellList.SetMinAndMaxCells(Item: TbiffCell);
begin
// do nothing
end;

procedure TbiffCellList.SetColRowNumber(Item: TbiffCell);
begin
// do nothing
end;

function TbiffCellList.Add(Item: TbiffCell): integer;
begin
  Result := inherited Add(Item);
  FSorted := false;
  Item.OnDestroy := OnDestroyItem;
  SetMinAndMaxCells(Item);
  if Count = 1 then SetColRowNumber(Item);
end;

procedure TbiffCellList.Insert(Index: integer; Item: TbiffCell);
begin
  inherited Insert(Index, Item);
  Item.OnDestroy := OnDestroyItem;
end;

procedure TbiffCellList.OnDestroyItem(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    if Items[i] = Sender then begin
      Remove(Items[i]);
      Break;
    end;
end;

{ TxlsRow }

constructor TxlsRow.Create(Workbook: TxlsWorkbook);
begin
  inherited;
  FRowNumber := -1;
  FMinCol := -1;
  FMaxCol := -1;
end;

procedure TxlsRow.SetMinAndMaxCells(Item: TbiffCell);
begin
  if (FMinCol = -1) or (Item.Col < FMinCol) then
    FMinCol := Item.Col;
  if (FMaxCol = -1) or (Item.Col > FMaxCol) then
    FMaxCol := Item.Col;
end;

procedure TxlsRow.SetColRowNumber(Item: TbiffCell);
begin
  FRowNumber := Item.Row;
end;

function TxlsRow.Find(Col: integer; var Index: integer): boolean;
var
 L, H, I, C: Integer;
begin
  if not Sorted then Sort;
  Result := false;
  L := 0;
  H := Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;
    if Items[i].Col < Col then
      C := -1
    else if Items[i].Col > Col then
      C := 1
    else C := 0;
    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;

function CompareCellCols(Item1, Item2: Pointer): integer;
begin
  if TbiffCell(Item1).Col < TbiffCell(Item2).Col then
    Result := -1
  else if TbiffCell(Item1).Col > TbiffCell(Item2).Col then
    Result := 1
  else Result := 0;
end;

procedure TxlsRow.Sort;
begin
  inherited Sort(CompareCellCols);
  Sorted := true;
end;

{ TxlsCol }

constructor TxlsCol.Create(Workbook: TxlsWorkbook);
begin
  inherited;
  FColNumber := -1;
  FMinRow := -1;
  FMaxRow := -1;
end;

procedure TxlsCol.SetMinAndMaxCells(Item: TbiffCell);
begin
  if (FMinRow = -1) or (Item.Row < FMinRow) then
    FMinRow := Item.Row;
  if (FMaxRow = -1) or (Item.Row > FMaxRow) then
    FMaxRow := Item.Row;
end;

procedure TxlsCol.SetColRowNumber(Item: TbiffCell);
begin
  FColNumber := Item.Col;
end;

function TxlsCol.Find(Row: integer; var Index: integer): boolean;
var
 L, H, I, C: Integer;
begin
  if not Sorted then Sort;
  Result := false;
  L := 0;
  H := Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;
    if Items[i].Row < Row then
      C := -1
    else if Items[i].Row > Row then
      C := 1
    else C := 0;
    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;

function CompareCellRows(Item1, Item2: Pointer): integer;
begin
  if TbiffCell(Item1).Row < TbiffCell(Item2).Row then
    Result := -1
  else if TbiffCell(Item1).Row > TbiffCell(Item2).Row then
    Result := 1
  else Result := 0;
end;

procedure TxlsCol.Sort;
begin
  inherited Sort(CompareCellRows);
  Sorted := true;
end;

{ TbiffShrFmlaList }

function TbiffShrFmlaList.GetItems(Index: integer): TbiffShrFmla;
begin
  Result := TbiffShrFmla(inherited Items[Index]);
end;

procedure TbiffShrFmlaList.SetItems(Index: integer; Value: TbiffShrFmla);
begin
  inherited Items[Index] := Value;
end;

function TbiffShrFmlaList.Add(Item: TbiffShrFmla): integer;
begin
  Result := inherited Add(Item);
  FSorted := false;
end;

procedure TbiffShrFmlaList.Insert(Index: integer; Item: TbiffShrFmla);
begin
  inherited Insert(Index, Item);
end;

function TbiffShrFmlaList.Find(Key: integer; var Index: integer): boolean;
Var
 L, H, I, C: Integer;
begin
  if not FSorted then Sort;
  Result := false;
  L := 0;
  H := Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;
    if Items[i].Key < Key then
      C := -1
    else if Items[i].Key > Key then
      C := 1
    else C := 0;
    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;

function CompareFormulaKey(Item1, Item2: Pointer): integer;
begin
  if TbiffShrFmla(Item1).Key < TbiffShrFmla(Item2).Key then
    Result := -1
  else if TBiffShrFmla(Item1).Key > TBiffShrFmla(Item2).Key then
    Result := 1
  else Result := 0;
end;

procedure TbiffShrFmlaList.Sort;
begin
  inherited Sort(CompareFormulaKey);
  FSorted := true;
end;

{ TbiffNameList }

function TbiffNameList.GetItems(Index: integer): TbiffName;
begin
  Result := TbiffName(inherited Items[Index]);
end;

procedure TbiffNameList.SetItems(Index: integer; Value: TbiffName);
begin
  inherited Items[Index] := Value;
end;

function TbiffNameList.Add(Item: TbiffName): integer;
begin
  Result := inherited Add(Item);
end;

procedure TbiffNameList.Insert(Index: integer; Item: TbiffName);
begin
  inherited Insert(Index, Item);
end;

{ TbiffBoundSheetList }

function TbiffBoundSheetList.GetItems(Index: integer): TbiffBoundSheet;
begin
  Result := TbiffBoundSheet(inherited Items[Index]);
end;

procedure TbiffBoundSheetList.SetItems(Index: integer; Value: TbiffBoundSheet);
begin
  inherited Items[Index] := Value;
end;

function TbiffBoundSheetList.Add(Item: TbiffBoundSheet): integer;
begin
  Result := inherited Add(Item);
end;

procedure TbiffBoundSheetList.Insert(Index: integer; Item: TbiffBoundSheet);
begin
  inherited Insert(Index, Item);
end;

function TbiffBoundSheetList.GetName(Index: integer): WideString;
begin
  Result := Items[Index].Name;
end;

{ TbiffXFList }

function TbiffXFList.GetItems(Index: integer): TbiffXF;
begin
  Result := TbiffXF(inherited Items[Index]);
end;

procedure TbiffXFList.SetItems(Index: integer; Value: TbiffXF);
begin
  inherited Items[Index] := Value;
end;

function TbiffXFList.Add(Item: TbiffXF): integer;
begin
  Result := inherited Add(Item);
end;

procedure TbiffXFList.Insert(Index: integer; Item: TbiffXF);
begin
  inherited Insert(Index, Item);
end;

{ TbiffFormatList }

function TbiffFormatList.GetItems(Index: integer): TbiffFormat;
begin
  Result := TbiffFormat(inherited Items[Index]);
end;

procedure TbiffFormatList.SetItems(Index: integer; Value: TbiffFormat);
begin
  inherited Items[Index] := Value;
end;

function TbiffFormatList.GetFormat(ID: integer): WideString;
var
  Index: integer;
begin
  if Find(ID, Index) then
    Result := Items[Index].Value
  else if (ID >= Low(InternalNumberFormats)) and (ID <= High(InternalNumberFormats)) then
    Result := InternalNumberFormats[ID]
  else Result := EmptyStr;
end;

function TbiffFormatList.Add(Item: TbiffFormat): integer;
begin
  Result := inherited Add(Item);
  FSorted := false;
end;

procedure TbiffFormatList.Insert(Index: integer; Item: TbiffFormat);
begin
  inherited Insert(Index, Item);
end;

function TbiffFormatList.Find(ID: integer; var Index: integer): boolean;
var
 L, H, I, C: Integer;
begin
  if not FSorted then Sort;
  Result := false;
  L := 0;
  H := Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;
    if Items[i].ID < ID then
      C := -1
    else if Items[i].ID > ID then
      C := 1
    else C := 0;
    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;

function CompareFormat(Item1, Item2: Pointer): integer;
begin
  if TbiffFormat(Item1).ID < TbiffFormat(Item2).ID then
    Result := -1
  else if TbiffFormat(Item1).ID > TbiffFormat(Item2).ID then
    Result := 1
  else Result := 0;
end;

procedure TbiffFormatList.Sort;
begin
  inherited Sort(CompareFormat);
  FSorted := true;
end;

{ TbiffSSTList }

function TbiffSSTList.GetItems(Index: integer): TxlsSSTEntry;
begin
  Result := TxlsSSTEntry(inherited Items[Index]);
end;

procedure TbiffSSTList.SetItems(Index: integer; Value: TxlsSSTEntry);
begin
  inherited Items[Index] := Value;
end;

function TbiffSSTList.Add(Item: TxlsSSTEntry): integer;
begin
  Result := inherited Add(Item);
end;

procedure TbiffSSTList.Insert(Index: integer; Item: TxlsSSTEntry);
begin
  inherited Insert(Index, Item);
end;

function TbiffSSTList.Find(Str: TxlsString; 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 := Items[I].Value.Compare(Str);
    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;

function CompareSSTEntries(Item1, Item2: Pointer): integer;
begin
  Result := TxlsSSTEntry(Item1).Value.Compare(TxlsSSTEntry(Item2).Value);
end;

procedure TbiffSSTList.Sort;
begin
  inherited Sort(CompareSSTEntries)
end;

procedure TbiffSSTList.Load(SST: TbiffSST);
var
  i, Offset: integer;
  Str: TxlsString;
  Tmp: TbiffRecord;
begin
  Offset := 8;
  Tmp := SST;
  for i := 0 to SST.Count - 1 do
  begin
    Str := TxlsString.CreateR(true, Tmp, Offset);
    Add(TxlsSSTEntry.CreateXS(Str));
  end;
end;

function TbiffSSTList.AddString(const Str: WideString): integer;
var
  S: TxlsString;
  Entr: TxlsSSTEntry;
begin
  S := TxlsString.CreateWS(true, Str);
  if Find(S, Result) then
    Items[Result].IncRef
  else begin
    Entr := TxlsSSTEntry.CreateXS(S);
    Entr.IncRef;
    Insert(Result, Entr);
  end;
end;

{ TxlsSection }

constructor TxlsSection.Create(Workbook: TxlsWorkbook);
begin
  inherited Create;
  FWorkbook := Workbook;
  FBOF := nil;
  FEOF := nil;
end;

destructor TxlsSection.Destroy;
begin
  if Assigned(FOnDestroy) then FOnDestroy(Self);
  Clear;
  inherited;
end;

procedure TxlsSection.Clear;
begin
  if Assigned(FBOF) then begin
    FBOF.Free;
    FBOF := nil;
  end;
  if Assigned(FEOF) then begin
    FEOF.Free;
    FEOF := nil;
  end;
end;

{ TxlsGlobals }

constructor TxlsGlobals.Create(Workbook: TxlsWorkbook);
begin
  inherited;
  FBoundSheetList := TbiffBoundSheetList.Create(Workbook);
  FNameList := TbiffNameList.Create(Workbook);
  FSSTList := TbiffSSTList.Create(Workbook);
  FXFList := TbiffXFList.Create(Workbook);
  FFormatList := TbiffFormatList.Create(Workbook);
end;

destructor TxlsGlobals.Destroy;
begin
  Clear;
  FBoundSheetList.Free;
  FNameLis