Скачиваний:
31
Добавлен:
01.05.2014
Размер:
6 Кб
Скачать
unit Range;

interface

  uses
    SysUtils,
    Contnrs,
    dmmTypes,
    StringObject,
    Exceptions,
    math;

  type
    TDMRange = class
    protected
      //столбец значений в формате строки
      m_RangeStrings : TObjectList;

      //список выбранных столбцов
      m_SelectFlags : boolArray;

      //максимальное значение в диапазоне
      m_Upper : integer;

    public
      constructor Create();overload;
      constructor Create(rangeList : AnsiString);overload;
      destructor Destroy(); override;
      procedure DefaultSettings();
      procedure setRanges(rangeList : AnsiString);
      procedure setUpper(newUpper : integer);
      function isInRange(index : integer) : boolean;
      function getRanges() : AnsiString;
      function isValidRange(range : AnsiString) : boolean;

    protected
      procedure setFlags();
      function rangeLower(range :  AnsiString ) : integer;
      function rangeSingle(single : AnsiString) : integer;
      function rangeUpper(range : AnsiString): integer;
    end;

implementation

  constructor TDMRange.Create();
  begin
    DefaultSettings();
  end;

  constructor TDMRange.Create(rangeList : AnsiString);
  begin
    DefaultSettings();
    setRanges(rangeList);
  end;

  procedure TDMRange.DefaultSettings();
  begin
    m_RangeStrings := TObjectList.Create();
    m_Upper := -1;
  end;

  function TDMRange.isValidRange(range : AnsiString) : boolean;
  var
    hyphenIndex : integer;
    index: integer;
    sValidRange,eValidRange : AnsiString;
  begin
    if (range = '') then
    begin
      result := false;
      exit;
    end;
    hyphenIndex := pos('-',range);
    if (hyphenIndex  > 0) then
    begin
      sValidRange := Copy(range,1, hyphenIndex-1);
      eValidRange := Copy(range, hyphenIndex + 1, length(range) - (hyphenIndex ));
      if isValidRange(sValidRange) and
	      isValidRange(eValidRange) then
      begin
        result := true;
        exit;
      end;
      result := false;
      exit;
    end;
    if (LowerCase(range) = ('first')) then
    begin
      result := true;
      exit;
    end;
    if (LowerCase(range) = ('last')) then
    begin
      result := true;
      exit;
    end;
    try
      index := StrToInt(range);
      if (index > 0) and (index <= m_Upper + 1) then
      begin
	      result := true;
        exit;
      end;
      result := false;
    except
      on E: Exception do result := false;
    end;
  end;

  function TDMRange.rangeSingle(single : AnsiString) : integer;
  var
    index : integer;
  begin
    if (LowerCase(single) = 'first') then
    begin
      result := 0;
      exit;
    end;
    if (LowerCase(single) = 'last') then
    begin
      result := m_Upper;
      exit;
    end;
    index := StrToInt(single) - 1;
    if (index < 0) then
      index := 0;

    if (index > m_Upper) then
      index := m_Upper;

    result := index;
  end;

  function TDMRange.rangeUpper(range : AnsiString): integer;
  var
    hyphenIndex : integer;
  begin
    hyphenIndex := pos('-',range);
    if (hyphenIndex  > 0) then
    begin
      result := max(rangeUpper(Copy(range,1, hyphenIndex-1)),
	                  rangeUpper(Copy(range,hyphenIndex + 1,
                    length(range)-(hyphenIndex))));
      exit;
    end;
    result := rangeSingle(range);
  end;

  function TDMRange.rangeLower(range :  AnsiString ) : integer;
  var
    hyphenIndex : integer;
  begin
    hyphenIndex := pos('-',range);
    if (hyphenIndex  > 0) then
    begin
      result := min(rangeLower(Copy(range,1, hyphenIndex-1)),
	                  rangeLower(Copy(range, hyphenIndex + 1,
                    length(range)-(hyphenIndex))));
      exit;
    end;
    result := rangeSingle(range);
  end;

  procedure TDMRange.setFlags();
  var
    i,j : integer;
    currentRange : AnsiString;
    rStart : integer;
    rEnd : integer;
  begin
    SetLength( m_SelectFlags,m_Upper + 1);
    i := 0;
    while (i < m_RangeStrings.Count) do
    begin
      currentRange := (m_RangeStrings[i] as TDMStringObject).stringValue();
      if not (isValidRange(currentRange)) then
        raise EIllegalArgumentException.Create('Недопустимый диапазон');
      rStart := rangeLower(currentRange);
      rEnd := rangeUpper(currentRange);

      j := rStart;
      while   (j <= m_Upper) and (j <= rEnd) do
      begin
        m_SelectFlags[j] := true;
        inc(j);
      end;
      inc(i);
    end;
  end;

  procedure TDMRange.setUpper(newUpper : integer);
  begin
    if (newUpper >= 0) then
    begin
      m_Upper := newUpper;
      setFlags();
    end;
  end;

  procedure TDMRange.setRanges(rangeList : AnsiString);
  var
    ranges : TObjectList;
    range : AnsiString;
    commaLoc : integer;
  begin
    ranges := TObjectList.Create();

    while not (rangeList = '') do
    begin
      range := trim(rangeList);
      commaLoc := pos(',',rangeList);
      if (commaLoc <> 0) then
      begin
	      range := trim(Copy(rangeList, 1, commaLoc-1));
	      rangeList := trim(Copy(rangeList, commaLoc+1, length(rangeList)-
                          (commaLoc)));
      end
      else
	      rangeList := '';

      if not (range = '') then
	      ranges.Add(TDMStringObject.Create(range));
    end;
    FreeAndNil(m_RangeStrings);
    m_RangeStrings := ranges;
    m_SelectFlags := nil;
  end;

  function TDMRange.isInRange(index : integer) : boolean;
  begin
    if (m_Upper = -1) then
      raise ERuntimeException.Create('Для диапазона не определена верхняя граница');
    result := m_SelectFlags[index];
  end;

  function TDMRange.getRanges() : AnsiString;
  var
    i : integer;
  begin
    result := '';
    i := 0;
    while (i < m_RangeStrings.Count) do
    begin
      if (result = '') then
	      result := (m_RangeStrings[i] as TDMStringObject).stringValue
      else
        result := result + ',' + (m_RangeStrings[i] as TDMStringObject).stringValue;
      inc(i);
    end;
  end;

  destructor TDMRange.Destroy();
  begin
    m_RangeStrings.OwnsObjects := true;
    FreeAndNil(m_RangeStrings);
  end;
  
end.

Соседние файлы в папке DMCore