Скачиваний:
28
Добавлен:
01.05.2014
Размер:
6.29 Кб
Скачать
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