xlsmapparser3.pas

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

          rdDown: begin
            if (FRow1 = 0) and (FRow2 = 0) then
              Result := Result + Col2Letter(FCol1) + ARRAY_DELIMITER + COLFINISH
            else if (FRow1 = 0) and (FRow2 > 0) then
              Result := Result + COLSTART + ARRAY_DELIMITER +
                Col2Letter(FCol2) + Row2Number(FRow2)
            else if (FRow1 > 0) and (FRow2 = 0) then
              Result := Result + Col2Letter(FCol1) + Row2Number(FRow1) +
                ARRAY_DELIMITER + COLFINISH;
          end;
          rdUp: begin
            if (FRow1 = 0) and (FRow2 = 0) then
              Result := Result + Col2Letter(FCol1) + ARRAY_DELIMITER + COLSTART
            else if (FRow1 = 0) and (FRow2 > 0) then
              Result := Result + COLFINISH + ARRAY_DELIMITER +
                Col2Letter(FCol2) + Row2Number(FRow2)
            else if (FRow1 > 0) and (FRow2 = 0) then
              Result := Result + Col2Letter(FCol1) + Row2Number(FRow1) +
                ARRAY_DELIMITER + COLSTART;
          end;
        end;
    end;
    rtRow: begin
      if (FCol1 > 0) and (FCol2 > 0) then
        Result := Result + Col2Letter(FCol1) + Row2Number(FRow1) +
          ARRAY_DELIMITER + Col2Letter(FCol2) + Row2Number(FRow2)
      else
        case FDirection of
          rdDown: begin
            if (FCol1 = 0) and (FCol2 = 0) then
              Result := Result + Row2Number(FRow1) + ARRAY_DELIMITER + ROWFINISH
            else if (FCol1 = 0) and (FCol2 > 0) then
              Result := Result + ROWSTART + ARRAY_DELIMITER +
                Col2Letter(FCol2) + Row2Number(FRow2)
            else if (FCol1 > 0) and (FCol2 = 0) then
              Result := Result + Col2Letter(FCol1) + Row2Number(FRow1) +
                ARRAY_DELIMITER + ROWFINISH;
          end;
          rdUp: begin
            if (FCol1 = 0) and (FCol2 = 0) then
              Result := Result + Row2Number(FRow1) + ARRAY_DELIMITER + ROWSTART
            else if (FCol1 = 0) and (FCol2 > 0) then
              Result := Result + ROWFINISH + ARRAY_DELIMITER +
                Col2Letter(FCol2) + Row2Number(FRow2)
            else if (FCol1 > 0) and (FCol2 = 0) then
              Result := Result + Col2Letter(FCol1) + Row2Number(FRow1) +
                ARRAY_DELIMITER + ROWSTART;
          end;
        end;
    end;
  end;
  if Result <> EmptyStr then Result := Result + RANGE_DELIMITER;
end;

function TMapRange.GetSkipFirstRows: integer;
begin
  Result := 0;
  if Assigned(MapRow) and Assigned(MapRow.MapRowList) then
    Result := MapRow.MapRowList.SkipFirstRows;
end;

function TMapRange.GetSkipFirstCols: integer;
begin
  Result := 0;
  if Assigned(MapRow) and Assigned(MapRow.MapRowList) then
    Result := MapRow.MapRowList.SkipFirstCols;
end;

{ TMapRow }

constructor TMapRow.Create(MapRowList: TMapRowList);
begin
  inherited Create;
  FMapRowList := MapRowList;
  if Assigned(FMapRowList) then
    FXLSFile := FMapRowList.XLSFile;
end;

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

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

function TMapRow.Add(Item: TMapRange): integer;
begin
  Result := inherited Add(Item);
  Item.Arrange;
end;

procedure TMapRow.Delete(Index: integer);
begin
  if Assigned(Items[Index]) then
    TMapRange(Items[Index]).Free;
  inherited;
end;

procedure TMapRow.Update;
var
  i: integer;
begin
  FLength := 0;
  for i := 0 to Count - 1 do
    Inc(FLength, Items[i].Length);
end;

function TMapRow.GetCellValue(AbsoluteIndex: integer): WideString;
var
  i: integer;
  RangeIndex: integer;
  S, C, R: integer;
begin
  Result := EmptyStr;

  if not Assigned(FXLSFile) then Exit;
  if (AbsoluteIndex <= 0) or (AbsoluteIndex > FLength) then Exit;

  RangeIndex := -1;
  for i := 0 to Count - 1 do
  begin
    if AbsoluteIndex > Items[i].Length then
      Dec(AbsoluteIndex, Items[i].Length)
    else begin
      RangeIndex := i;
      Break;
    end;
  end;
  if RangeIndex = -1 then Exit;

  S := 0;
  if Items[RangeIndex].HasSheet then
  begin
    if Items[RangeIndex].SheetNumber > 0
      then S := Items[RangeIndex].SheetNumber - 1
      else S := FXLSFile.Workbook.WorkSheets.IndexOfName(Items[RangeIndex].SheetName);
  end;

  C := -1; R := -1;
  case Items[RangeIndex].FRangeType of
    rtCell: begin
      C := Items[RangeIndex].Col1 - 1;
      R := Items[RangeIndex].Row1 - 1;
    end;
    rtCol: begin
      C := Items[RangeIndex].Col1 - 1;
      case Items[RangeIndex].FDirection of
        rdDown:
          if SkipFirstRows > 0
            then R := SkipFirstRows + 1 + (AbsoluteIndex - 1) - 1
            else R := Items[RangeIndex].Row1 + (AbsoluteIndex - 1) - 1;
        rdUp:
          R := Items[RangeIndex].Row1 - (AbsoluteIndex - 1) - 1;
      end
    end;
    rtRow: begin
      R := Items[RangeIndex].Row1 - 1;
      case Items[RangeIndex].FDirection of
        rdDown:
          if SkipFirstCols > 0
            then C := (SkipFirstCols + 1) + (AbsoluteIndex - 1) - 1
            else C := Items[RangeIndex].Col1 + (AbsoluteIndex - 1) - 1;
        rdUp: C := Items[RangeIndex].Col1 - (AbsoluteIndex - 1) - 1;
      end
    end;
  end;

  if Assigned(FXLSFile.Workbook.WorkSheets[S].Cells[R, C]) then
    Result := FXLSFile.Workbook.WorkSheets[S].Cells[R, C].AsString;
end;

procedure TMapRow.Optimize;
var
  i: integer;
begin
  for i := Count - 1 downto 0 do
    if i > 0 then
    begin
      if not ((Items[i - 1].SheetNumber = Items[i].SheetNumber) or
              (Items[i - 1].SheetName = Items[i].SheetName)) then Continue;

      case Items[i - 1].RangeType of
        rtCol:
          if (((Items[i].RangeType = rtCol) and
               (Items[i - 1].Direction = Items[i].Direction)) or
              (Items[i].RangeType = rtCell)) and
             (Items[i - 1].Col1 = Items[i].Col1) and
             (((Items[i - 1].Direction = rdDown) and
               (Items[i - 1].Row2 = Items[i].Row1 - 1)) or
              ((Items[i - 1].Direction = rdUp) and
               (Items[i - 1].Row2 = Items[i].Row1 + 1))) then
          begin
            Items[i - 1].Row2 := Items[i].Row2;
            Delete(i);
          end;
        rtRow:
          if (((Items[i].RangeType = rtRow) and
               (Items[i - 1].Direction = Items[i].Direction)) or
              (Items[i].RangeType = rtCell)) and
             (Items[i - 1].Row1 = Items[i].Row1) and
             (((Items[i - 1].Direction = rdDown) and
               (Items[i - 1].Col2 = Items[i].Col1 - 1)) or
              ((Items[i - 1].Direction = rdUp) and
               (Items[i - 1].Col2 = Items[i].Col1 + 1))) then
          begin
            Items[i - 1].Col2 := Items[i].Col2;
            Delete(i);
          end;
        rtCell:
          case Items[i].RangeType of
            rtCol:
              if Items[i - 1].Col1 = Items[i].Col1 then
              begin
                if ((Items[i].Direction = rdDown) and
                    (Items[i - 1].Row1 = Items[i].Row2 + 1)) or
                   ((Items[i].Direction = rdUp) and
                    (Items[i - 1].Row1 = Items[i].Row2 - 1)) then
                begin
                  Items[i - 1].Row1 := Items[i].Row1;

                  Items[i - 1].Update;
                  Items[i - 1].UpdateDirection;

                  Delete(i);
                end
                else if ((Items[i].Direction = rdDown) and
                         (Items[i - 1].Row1 = Items[i].Row1 - 1)) or
                        ((Items[i].Direction = rdUp) and
                         (Items[i - 1].Row1 = Items[i].Row1 + 1)) then
                begin
                  Items[i - 1].Row2 := Items[i].Row2;

                  Items[i - 1].Update;
                  Items[i - 1].UpdateDirection;

                  Delete(i);
                end
              end;
            rtRow:
              if Items[i - 1].Row1 = Items[i].Row1 then
              begin
                if ((Items[i].Direction = rdDown) and
                    (Items[i - 1].Col1 = Items[i].Col2 + 1)) or
                   ((Items[i].Direction = rdUp) and
                    (Items[i - 1].Col1 = Items[i].Col2 - 1)) then
                begin
                  Items[i - 1].Col1 := Items[i].Col1;

                  Items[i - 1].Update;
                  Items[i - 1].UpdateDirection;

                  Delete(i);
                end
                else if ((Items[i].Direction = rdDown) and
                         (Items[i - 1].Col1 = Items[i].Col1 - 1)) or
                        ((Items[i].Direction = rdUp) and
                         (Items[i - 1].Col1 = Items[i].Col1 + 1)) then
                begin
                  Items[i - 1].Col2 := Items[i].Col2;

                  Items[i - 1].Update;
                  Items[i - 1].UpdateDirection;

                  Delete(i);
                end
              end;
            rtCell:
              if (Items[i - 1].Col1 = Items[i].Col1) and
                 ((Items[i - 1].Row1 = Items[i].Row1 + 1) or
                  (Items[i - 1].Row1 = Items[i].Row1 - 1)) then
              begin
                Items[i - 1].Row2 := Items[i].Row1;

                Items[i - 1].Update;
                Items[i - 1].UpdateDirection;

                Delete(i);
              end
              else if (Items[i - 1].Row1 = Items[i].Row1) and
                      ((Items[i - 1].Col1 = Items[i].Col1 + 1) or
                       (Items[i - 1].Col1 = Items[i].Col1 - 1)) then
              begin
                Items[i - 1].Col2 := Items[i].Col1;

                Items[i - 1].Update;
                Items[i - 1].UpdateDirection;

                Delete(i);
              end
          end
      end;
    end
end;

function TMapRow.IndexOfRange(const RangeStr: string): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to Count - 1 do
    if AnsiCompareText(RangeStr, Items[i].AsString) = 0 then
    begin
      Result := i;
      Break;
    end;
end;

function TMapRow.GetAsString: string;
var
  i: integer;
begin
  Result := EmptyStr;
  for i := 0 to Count - 1 do
    Result := Result + Items[i].AsString;
end;

procedure TMapRow.SetAsString(const Value: string);
begin
  Clear;
  ParseMapString(Value, Self);
end;

function TMapRow.GetSkipFirstRows: integer;
begin
 Result := 0;
 if Assigned(MapRowList) then
   Result := MapRowList.SkipFirstRows;
end;

function TMapRow.GetSkipFirstCols: integer;
begin
 Result := 0;
 if Assigned(MapRowList) then
   Result := MapRowList.SkipFirstCols;
end;

{ TMapRowList }

constructor TMapRowList.Create(XLSFile: TxlsFile);
begin
  inherited Create;
  FXLSFile := XLSFile;
  FMinRow := -1;
  FMaxRow := -1;
  FSkipFirstCols := 0;
  FSkipFirstRows := 0;
end;

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

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

function TMapRowList.Add(Item: TMapRow): integer;
begin
  Result := inherited Add(Item);
end;

procedure TMapRowList.Delete(Index: integer);
begin
  if Assigned(Items[Index]) then
    TMapRow(Items[Index]).Free;
  inherited;
end;

procedure TMapRowList.Update;
var
  i: integer;
begin
  FMinRow := -1;
  FMaxRow := -1;
  for i := 0 to Count - 1 do
  begin
    if (FMinRow = -1) or (Items[i].Length < Items[FMinRow].Length) then
      FMinRow := i;
    if (FMaxRow = -1) or (Items[i].Length > Items[FMaxRow].Length) then
      FMaxRow := i;
  end;
end;

end.