xlsmapparser3.pas

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

             Col := T;
           end;
           else raise Exception.CreateFmt(sLetterExpected, [Ch, i]);
         end;
    end;
    Buf := Buf + Ch;
  end;
end;

procedure ParseRowString(const RowString: string; var Row: integer);
type
  TState = 0..1;
var
  i: integer;
  Str: string;
  State: TState;
  Ch: char;
  SymbolType: TSymbolType;
  Buf: string;
  T: integer;
begin
  Str := RowString;
  if Str = EmptyStr then
    raise Exception.Create(sRowIsEmpty);
  Str := AnsiUpperCase(Trim(Str));
  if Str[Length(Str)] <> RANGE_DELIMITER then
    Str := Str + RANGE_DELIMITER;

  State := 0;
  Buf := EmptyStr;

  for i := 1 to Length(Str) do begin
    Ch := Str[i];
    SymbolType := GetSymbolType(Ch);
    if SymbolType = stUnknown then
      raise Exception.CreateFmt(sUnknownSymbol, [Ch, i]);
    case State of
      0: case SymbolType of
           stNumber: State := 1;
           else raise Exception.CreateFmt(sNumberExpected, [Ch, i]);
         end;
      1: case SymbolType of
           stNumber: State := 1;
           stRange: begin
             T := Number2Row(Buf);
             CheckRowNumber(T);
             if i <> Length(Str) then
               raise Exception.Create(sSoLongRowDefinition);
             Row := T;
           end;
           else raise Exception.CreateFmt(sNumberExpected, [Ch, i]);
         end;
    end;
    Buf := Buf + Ch;
  end;
end;

procedure ParseSheetNumber(const SheetNumber: string; var Sheet: integer);
type
  TState = 0..1;
var
  i: integer;
  Str: string;
  State: TState;
  Ch: char;
  SymbolType: TSymbolType;
  Buf: string;
  T: integer;
begin
  Str := SheetNumber;
  if Str = EmptyStr then
    raise Exception.Create(sSheetIsEmpty);
  Str := AnsiUpperCase(Trim(Str));
  if Str[Length(Str)] <> RANGE_DELIMITER then
    Str := Str + RANGE_DELIMITER;

  State := 0;
  Buf := EmptyStr;

  for i := 1 to Length(Str) do begin
    Ch := Str[i];
    SymbolType := GetSymbolType(Ch);
    if SymbolType = stUnknown then
      raise Exception.CreateFmt(sUnknownSymbol, [Ch, i]);
    case State of
      0: case SymbolType of
           stNumber: State := 1;
           else raise Exception.CreateFmt(sNumberExpected, [Ch, i]);
         end;
      1: case SymbolType of
           stNumber: State := 1;
           stRange: begin
             T := StrToInt(Buf);
             if i <> Length(Str) then
               raise Exception.Create(sSoLongSheetDefinition);
             Sheet := T;
           end;
           else raise Exception.CreateFmt(sNumberExpected, [Ch, i]);
         end;
    end;
    Buf := Buf + Ch;
  end;
end;

procedure ParseSheetName(const SheetName: string; var Sheet: string);
type
  TState = 0..1;
var
  i: integer;
  Str, Str1: string;
  State: TState;
  Ch: char;
  SymbolType: TSymbolType;
  Buf: string;
begin
  Str1 := Trim(SheetName);
  if Str1 = EmptyStr then
    raise Exception.Create(sSheetIsEmpty);
  Str := AnsiUpperCase(Str1);
  if Str[Length(Str)] <> RANGE_DELIMITER then
  begin
    Str := Str + RANGE_DELIMITER;
    Str1 := Str1 + RANGE_DELIMITER;
  end;

  State := 0;
  Buf := EmptyStr;

  for i := 1 to Length(Str) do begin
    Ch := Str[i];
    SymbolType := GetSymbolType(Ch);
    {if SymbolType = stUnknown then
      raise Exception.CreateFmt(sUnknownSymbol, [Str1[i], i]);}
    case State of
      0: begin
        if IsIllegalInSheet(Ch) then
          raise Exception.CreateFmt(sIllegalSheetChar, [Ch, i]);
        State := 1;
      end;
      1: case SymbolType of
           stRange: begin
             if i <> Length(Str) then
               raise Exception.Create(sSoLongSheetDefinition);
             Sheet := Buf;
           end;
           else begin
             if IsIllegalInSheet(Ch) then
               raise Exception.CreateFmt(sIllegalSheetChar, [Ch, i]);
             State := 1;
           end;
         end;
    end;
    Buf := Buf + Str1[i];
  end;
end;

function CellInRange(Range: TMapRange; const SheetName: string;
  SheetNumber, Col, Row: integer): boolean;
begin
  Result := false;
  Range.Update;

  if ((Range.SheetIDType = sitNumber) and (Range.SheetNumber <> SheetNumber)) or
     ((Range.SheetIDType = sitName) and (AnsiCompareText(Range.SheetName, SheetName) <> 0)) then
    Exit;

  case Range.RangeType of
    rtCol:
      if Range.Col1 = Col then begin
        if (Range.Row1 > 0) and (Range.Row2 > 0) then begin
          if Range.Row1 < Range.Row2 then
            Result := (Row >= Range.Row1) and (Row <= Range.Row2)
          else if Range.Row1 > Range.Row2 then
            Result := (Row >= Range.Row2) and (Row <= Range.Row1)
        end
        else if (Range.Row1 > 0) and (Range.Row2 = 0) then begin
          Result := ((Range.Direction = rdDown) and (Row >= Range.Row1)) or
                    ((Range.Direction = rdUp) and (Row <= Range.Row1));
        end
        else if (Range.Row1 = 0) and (Range.Row2 > 0) then begin
          Result := ((Range.Direction = rdDown) and (Row <= Range.Row1)) or
                    ((Range.Direction = rdUp) and (Row >= Range.Row1));
        end
        else if (Range.Row1 = 0) and (Range.Row2 = 0) then begin
          Result := true;
        end;
      end;
    rtRow:
      if Range.Row1 = Row then begin
        if (Range.Col1 > 0) and (Range.Col2 > 0) then begin
          if Range.Col1 < Range.Col2 then
            Result := (Col >= Range.Col1) and (Col <= Range.Col2)
          else if Range.Col1 > Range.Col2 then
            Result := (Col >= Range.Col2) and (Col <= Range.Col1)
        end
        else if (Range.Col1 > 0) and (Range.Col2 = 0) then begin
          Result := ((Range.Direction = rdDown) and (Col >= Range.Col1)) or
                    ((Range.Direction = rdUp) and (Col <= Range.Col1));
        end
        else if (Range.Col1 = 0) and (Range.Col2 > 0) then begin
          Result := ((Range.Direction = rdDown) and (Col <= Range.Col1)) or
                    ((Range.Direction = rdUp) and (Col >= Range.Col1));
        end
        else if (Range.Col1 = 0) and (Range.Col2 = 0) then begin
          Result := true;
        end;
      end;
    rtCell: Result := (Range.Col1 = Col) and (Range.Row1 = Row);
  end;
end;

function CellInRow(MapRow: TMapRow; const SheetName: string;
  SheetNumber, Col, Row: integer): boolean;
var
  i: integer;
begin
  Result := false;
  for i := 0 to MapRow.Count - 1 do
    if CellInRange(MapRow[i], SheetName, SheetNumber, Col, Row) then begin
      Result := true;
      Break;
    end;
end;

function GetCellNeighbours(MapRow: TMapRow; const SheetName: string;
  SheetNumber, Col, Row: integer): TCellNeighbours;
var
  i: integer;
begin
  Result := [];
  for i := 0 to MapRow.Count - 1 do begin
    if not (cnLeft in Result) and
       CellInRange(MapRow[i], SheetName, SheetNumber, Col - 1, Row) then
      Result := Result + [cnLeft];
    if not (cnRight in Result) and
       CellInRange(MapRow[i], SheetName, SheetNumber, Col + 1, Row) then
      Result := Result + [cnRight];
    if not (cnTop in Result) and
       CellInRange(MapRow[i], SheetName, SheetNumber, Col, Row - 1) then
      Result := Result + [cnTop];
    if not (cnBottom in Result) and
       CellInRange(MapRow[i], SheetName, SheetNumber, Col, Row + 1) then
      Result := Result + [cnBottom];
    if (cnLeft in Result) and (cnRight in Result) and (cnTop in Result) and
       (cnBottom in Result) then Break;
  end;
end;

procedure RemoveCellFromRow(MapRow: TMapRow; const SheetName: string;
  SheetNumber, Col, Row: integer);
var
  i: integer;
  str: string;
  R: TMapRange;
begin
  str := EmptyStr;
  for i := 0 to MapRow.Count - 1 do begin
    if not CellInRange(MapRow[i], SheetName, SheetNumber, Col, Row) then
      str := str + MapRow[i].AsString
    else begin
      case MapRow[i].RangeType of
        rtCol: begin
          if (MapRow[i].Row1 = Row) and (MapRow[i].Direction = rdDown) then
            MapRow[i].Row1 := MapRow[i].Row1 + 1
          else if (MapRow[i].Row1 = Row) and (MapRow[i].Direction = rdUp) then
            MapRow[i].Row1 := MapRow[i].Row1 - 1
          else if (MapRow[i].Row2 = Row) and (MapRow[i].Direction = rdDown) then
            MapRow[i].Row2 := MapRow[i].Row2 - 1
          else if (MapRow[i].Row2 = Row) and (MapRow[i].Direction = rdUp) then
            MapRow[i].Row2 := MapRow[i].Row2 + 1
          else if (MapRow[i].Row1 < Row) and (MapRow[i].Row2 > Row) and
                  (MapRow[i].Direction = rdDown) then begin
            R := TmapRange.Create(nil);
            try
              R.Col1 := MapRow[i].Col1;
              R.Col2 := MapRow[i].Col1;
              R.Row1 := MapRow[i].Row1;
              R.Row2 := Row - 1;
              R.Update;
              R.UpdateDirection;
              str := str + R.AsString;
            finally
              R.Free;
            end;
            MapRow[i].Row1 := Row + 1;
          end
          else if (MapRow[i].Row1 > Row) and (MapRow[i].Row2 < Row) and
                  (MapRow[i].Direction = rdUp) then begin
            R := TmapRange.Create(nil);
            try
              R.Col1 := MapRow[i].Col1;
              R.Col2 := MapRow[i].Col1;
              R.Row1 := MapRow[i].Row1;
              R.Row2 := Row + 1;
              R.Update;
              R.UpdateDirection;
              str := str + R.AsString;
            finally
              R.Free;
            end;
            MapRow[i].Row1 := Row - 1;
          end;
          str := str + MapRow[i].AsString;
        end;
        rtRow: begin
          if (MapRow[i].Col1 = Col) and (MapRow[i].Direction = rdDown) then
            MapRow[i].Col1 := MapRow[i].Col1 + 1
          else if (MapRow[i].Col1 = Col) and (MapRow[i].Direction = rdUp) then
            MapRow[i].Col1 := MapRow[i].Col1 - 1
          else if (MapRow[i].Col2 = Col) and (MapRow[i].Direction = rdDown) then
            MapRow[i].Col2 := MapRow[i].Col2 - 1
          else if (MapRow[i].Col2 = Col) and (MapRow[i].Direction = rdUp) then
            MapRow[i].Col2 := MapRow[i].Col2 + 1
          else if (MapRow[i].Col1 < Col) and (MapRow[i].Col2 > Col) and
                  (MapRow[i].Direction = rdDown) then begin
            R := TmapRange.Create(nil);
            try
              R.Col1 := MapRow[i].Col1;
              R.Col2 := Col - 1;
              R.Row1 := MapRow[i].Row1;
              R.Row2 := MapRow[i].Row1;
              R.Update;
              R.UpdateDirection;
              str := str + R.AsString;
            finally
              R.Free;
            end;
            MapRow[i].Col1 := Col + 1;
          end
          else if (MapRow[i].Col1 > Col) and (MapRow[i].Col2 < Col) and
                  (MapRow[i].Direction = rdUp) then begin
            R := TmapRange.Create(nil);
            try
              R.Col1 := MapRow[i].Col1;
              R.Col2 := Col + 1;
              R.Row1 := MapRow[i].Row1;
              R.Row2 := MapRow[i].Row1;
              R.Update;
              R.UpdateDirection;
              str := str + R.AsString;
            finally
              R.Free;
            end;
            MapRow[i].Col1 := Col - 1;
          end;
          str := str + MapRow[i].AsString;
        end;
      end;
    end;
  end;
  MapRow.AsString := str;
end;

procedure Str2ColRow(const Str: string; var ACol, ARow: integer);
var
  c, r: string;
  i: integer;
begin
  c := EmptyStr;
  r := EmptyStr;
  i := 1;
  while (i <= Length(Str)) and (Pos(Str[i], LETTERS) > 0) do begin
    c := c + Str[i];
    Inc(i);
  end;
  while (i <= Length(Str)) and (Pos(Str[i], NUMBERS) > 0) do begin
    r := r + Str[i];
    Inc(i);
  end;
  ACol := Letter2Col(c);
  ARow := Number2Row(r);
end;

procedure Str2Range(const Str: string; var ACol1, ARow1, ACol2, ARow2: integer);
begin
  Str2ColRow(Copy(Str, 1, Pos('-', Str) - 1), ACol1, ARow1);
  Str2ColRow(Copy(Str, Pos('-', Str) + 1, Length(Str) - Pos('-', Str) + 1), ACol2, ARow2);
end;

function GetRangeType(const Str: string): TRangeType;
var
  c1, r1, c2, r2: integer;
begin
  Result := rtCell;
  if Pos('-', Str) = 0 then Exit
  else begin
    Str2Range(Str, c1, r1, c2, r2);
    if c1 = c2 then Result := rtCol
    else if r1 = r2 then Result := rtRow;
  end;