БланкСШаблоном "Работа с диапазонами";

-- Глобальные данные
------------------------------------------------------------------------------------------

var осн :i; -- фрейм для тестов
var нов :i; -- фрейм для тестов

---- Данные диапазонов 1
var буфСер1     :S;  -- серия
var буфНач1     :N;  -- начальное значение
var буфКон1     :N;  -- конечное значение
var буфКол1     :N;  -- количество
var буфРазм1    :I;  -- размер
var буфПризн1   :S;  -- признак
var буфЦена1    :N;  -- цена

---- Данные диапазонов 2
var буфСер2     :S;  -- серия
var буфНач2     :N;  -- начальное значение
var буфКон2     :N;  -- конечное значение
var буфКол2     :N;  -- количество
var буфРазм2    :I;  -- размер
var буфПризн2   :S;  -- признак
var буфЦена2    :N;  -- цена

---- Данные новых диапазонов
var буфСерНов   :S;  -- серия
var буфНачНов   :N;  -- начальное значение
var буфКонНов   :N;  -- конечное значение
var буфКолНов   :N;  -- количество
var буфРазмНов  :I;  -- размер
var буфПризнНов :S;  -- признак
var буфЦенаНов  :N;  -- цена

---- Диапазоны
var ОснСер[]    :S;
var ОснНач[]    :N;
var ОснКон[]    :N;
var ОснКол[]    :N;
var ОснРазм[]   :I;
var ОснПризн[]  :S;
var ОснЦена[]   :N;

---- Новые диапазоны
var НовСер[]    :S;
var НовНач[]    :N;
var НовКон[]    :N;
var НовКол[]    :N;
var НовРазм[]   :I;
var НовПризн[]  :S;
var НовЦена[]   :N;

------------------------------------------------------------------------------------------

-- Глобальные процедуры и функции
------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------
-- Извлекает в глобальные переменные данные диапазонов 
Proc Извлечь (инд : i; набор :i);
  if набор = 1: буфСер1   = ОснСер[инд];
                буфНач1   = ОснНач[инд];
                буфКон1   = ОснКон[инд];
                буфКол1   = ОснКол[инд];
                буфРазм1  = ОснРазм[инд];
                буфПризн1 = ОснПризн[инд];
                буфЦена1  = ОснЦена[инд];
    |набор = 2: буфСер2   = ОснСер[инд];
                буфНач2   = ОснНач[инд];
                буфКон2   = ОснКон[инд];
                буфКол2   = ОснКол[инд];
                буфРазм2  = ОснРазм[инд];
                буфПризн2 = ОснПризн[инд];
                буфЦена2  = ОснЦена[инд];
  fi;
end;

--------------------------------------------------------------------------------------------
---- Сохранить диапазон
Proc Сохранить (инд : i; набор :i);
  if набор = 1: ОснСер[инд]   =буфСер1;
                ОснНач[инд]   =буфНач1;
                ОснКон[инд]   =буфКон1;
                ОснКол[инд]   =буфКол1;
                ОснРазм[инд]  =буфРазм1;
                ОснПризн[инд] =буфПризн1;
                ОснЦена[инд]  =буфЦена1;
    |набор = 2: ОснСер[инд]   =буфСер2;
                ОснНач[инд]   =буфНач2;
                ОснКон[инд]   =буфКон2;
                ОснКол[инд]   =буфКол2;
                ОснРазм[инд]  =буфРазм2;
                ОснПризн[инд] =буфПризн2;
                ОснЦена[инд]  =буфЦена2;
    |набор = 3: НовСер[инд]   =буфСерНов;
                НовНач[инд]   =буфНачНов;
                НовКон[инд]   =буфКонНов;
                НовКол[инд]   =буфКолНов;
                НовРазм[инд]  =буфРазмНов;
                НовПризн[инд] =буфПризнНов;
                НовЦена[инд]  =буфЦенаНов;
  fi;
end;

--------------------------------------------------------------------------------------------
---- Удалить диапазон
Proc УдалитьД (инд : i);
  var f :i;
  DeleteFromArray(ОснСер, инд);
  DeleteFromArray(ОснНач, инд);
  DeleteFromArray(ОснКон, инд);
  DeleteFromArray(ОснКол, инд);
  DeleteFromArray(ОснРазм, инд);
  DeleteFromArray(ОснПризн, инд);
  DeleteFromArray(ОснЦена, инд);
end;

------------------------------------------------------------------------------------------
-- Очистка
Proc Очистка;
  ClearVariable(РАБ.ДИАПАЗОНЫ.ОснСер);
  ClearVariable(РАБ.ДИАПАЗОНЫ.ОснНач);
  ClearVariable(РАБ.ДИАПАЗОНЫ.ОснКон);
  ClearVariable(РАБ.ДИАПАЗОНЫ.ОснКол);
  ClearVariable(РАБ.ДИАПАЗОНЫ.ОснРазм);
  ClearVariable(РАБ.ДИАПАЗОНЫ.ОснПризн);
  ClearVariable(РАБ.ДИАПАЗОНЫ.ОснЦена);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовСер);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовНач);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовКон);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовКол);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовРазм);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовПризн);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовЦена);
end;

------------------------------------------------------------------------------------------
---- Диапазон1 в новый диапазон
Proc ПервоеВНовое;
  буфСерНов   = буфСер1;
  буфРазмНов  = буфРазм1;
  буфПризнНов = буфПризн1;
  буфЦенаНов  = буфЦена1;
end;

------------------------------------------------------------------------------------------
----
Func КолД :Integer;
  return LengthOfArray(ОснСер);
end;

Func КолДН :Integer;
  return LengthOfArray(НовСер);
end;

--------------------------------------------------------------------------------------------
---- Разбивка диапазонов на элементарные с учетом пересечения диапазонов
Func Разбивка :Logical;
  var n, p, pp: i;
  var upd :l;
  var кол: n;
  p = 1;
  upd = false;
  n = КолД;
  ShowProgress(100,"Расчет диапазонов...");
  try
    while (p < n) do
      Извлечь(p, 1);
      pp = p + 1;
      while (pp <= n) do
        Извлечь(pp, 2);
        if (буфСер2 = буфСер1) and (буфРазм2 = буфРазм1) and (буфПризн1 = буфПризн2) and (буфЦена1 = буфЦена2): -- обработка, если совпадают серии, размеры, признаки, цена
             --------------------------------------------------------------------------------------------------------
          if (буфНач2 < буфНач1) and (буфКон2 < буфКон1) and (буфНач1 <= буфКон2):
             -- Вариант 1: вторая отсекает левый кусок первой
             буфНачНов = буфНач1;
             буфКонНов = буфКон2;
             буфКолНов = буфКол1 + буфКол2;
             if буфКолНов <> 0: ПервоеВНовое; Сохранить(КолДН + 1,3); fi;
             буфКон2 = буфНач1 - 1;
             буфНач1 = буфКонНов + 1;
             Сохранить(p,1);
             Сохранить(pp,2);
             pp = pp + 1;
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфКон2 > буфКон1) and (буфНач2 > буфНач1) and (буфКон1 >= буфНач2):
             -- Вариант 2: вторая отсекает правый кусок первой
             буфНачНов = буфНач2;
             буфКонНов = буфКон1;
             буфКолНов = буфКол1 + буфКол2;
             if буфКолНов <> 0: ПервоеВНовое; Сохранить(КолДН + 1,3); fi;
             буфКон1 = буфНач2 - 1; Сохранить(p,1);
             буфНач2 = буфКонНов + 1; Сохранить(pp,2);
             pp = pp + 1;
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфНач2 > буфНач1) and (буфКон2 < буфКон1):
             -- Вариант 3: вторая внутри первой
             буфНачНов = буфНач2;
             буфКонНов = буфКон2;
             буфКолНов = буфКол1 + буфКол2;
             if буфКолНов <> 0: ПервоеВНовое; Сохранить(КолДН + 1,3); fi;
             буфКон2 = буфКон1;
             буфКон1 = буфНачНов - 1;
             буфНач2 = буфКонНов + 1;
             буфКол2 = буфКол1;
             Сохранить(p,1);
             Сохранить(pp,2);
             pp = pp + 1;
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфНач2 > буфНач1) and (буфКон2 = буфКон1):
             -- Вариант 3а: вторая внутри первой с общей стороной справа
             буфКон1 = буфНач2 - 1;
             буфКол2 = буфКол1 + буфКол2;
             Сохранить(p,1);
             Сохранить(pp,2);
             pp = pp + 1;
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфКон1 > буфКон2) and (буфНач1 = буфНач2):
             -- Вариант 3б: вторая внутри первой с общей стороной слева
             буфНач1 = буфКон2 + 1;
             буфКол2 = буфКол1 + буфКол2;
             Сохранить(p,1);
             Сохранить(pp,2);
             pp = pp + 1;
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфНач2 < буфНач1) and (буфКон2 > буфКон1):
             -- Вариант 4: первая внутри второй
             буфНачНов = буфНач1;
             буфКонНов = буфКон1;
             буфКолНов = буфКол1 + буфКол2;
             if буфКолНов <> 0: ПервоеВНовое; Сохранить(КолДН + 1,3); fi;
             буфНач1 = буфНач2;
             буфКон1 = буфНачНов - 1;
             буфНач2 = буфКонНов + 1;
             буфКол1 = буфКол2;
             Сохранить(p,1);
             Сохранить(pp,2);
             pp = pp + 1;
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфНач2 < буфНач1) and (буфКон2 = буфКон1):
             -- Вариант 4а: первая внутри второй с общей стороной справа
             буфКон2 = буфНач1 - 1;
             буфКол1 = буфКол1 + буфКол2;
             Сохранить(p,1);
             Сохранить(pp,2);
             pp = pp + 1;
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфКон1 < буфКон2) and (буфНач1 = буфНач2):
             -- Вариант 4б: первая внутри второй с общей стороной слева
             буфНач2 = буфКон1 + 1;
             буфКол1 = буфКол1 + буфКол2;
             Сохранить(p,1);
             Сохранить(pp,2);
             pp = pp + 1;
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфНач1 < буфНач2) and (буфНач2 - буфКон1 = 1) and (буфКол1 = буфКол2):
             -- Объединение интервалов
             буфКон1 = буфКон2;
             Сохранить(p,1);
             УдалитьД(pp);
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфНач2 < буфНач1) and (буфНач1 - буфКон2 = 1) and (буфКол1 = буфКол2):
             -- Объединение интервалов
             буфНач1 = буфНач2;
             Сохранить(p,1);
             УдалитьД(pp);
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | (буфНач1 = буфНач2) and (буфКон1 = буфКон2):
             -- Объединение совпадающих интервалов
             буфКол1 = буфКол1 + буфКол2;
             Сохранить(p,1);
             УдалитьД(pp);
             upd = true;
             --------------------------------------------------------------------------------------------------------
           | true: -- Вариант 5: независимые области
             pp = pp + 1;
             --------------------------------------------------------------------------------------------------------
          fi;

          -- удаляем дипазоны если значения нулевые
          if буфКол1 = 0:
            УдалитьД(p);
            p = p - 1;
            n = КолД;
            break;
          fi;
          if буфКол2 = 0:
            pp = pp - 1;
            УдалитьД(pp);
          fi;

          n = КолД;
        else
          pp = pp + 1;
        fi;
      od;
      ProgressPos(Int(p*100/КолД));
      p = p + 1;
    od;
  finally
    CloseProgress;
  end;
  return upd;
end;

------------------------------------------------------------------------------------------
-- Сортировка диапазонов по возрастанию
Proc Сортировка;
  var i, j, tmp, len :i;
  var key :n;
  var keytxt, keyser :s;
  len = КолД;
  for i = 2 .. len do
    Извлечь(i, 1);
    key = буфНач1;
    keyser = буфСер1;
    j = i - 1;
    while ((ОснСер[j] > keyser) or (ОснСер[j] = keyser and ОснНач[j] > key)) do
      Извлечь(j, 2);
      Сохранить(j + 1, 2);
      j = j - 1;
      if j < 1: break; fi;
    od;
    Сохранить(j + 1, 1);
  od;
end;

------------------------------------------------------------------------------------------
-- Копирование новых диапазонов в рабочие
Proc НовоеВСтарое;
  CopyArray(НовСер,   ОснСер,   1, LengthOfArray(ОснСер)   + 1);
  CopyArray(НовНач,   ОснНач,   1, LengthOfArray(ОснНач)   + 1);
  CopyArray(НовКон,   ОснКон,   1, LengthOfArray(ОснКон)   + 1);
  CopyArray(НовКол,   ОснКол,   1, LengthOfArray(ОснКол)   + 1);
  CopyArray(НовРазм,  ОснРазм,  1, LengthOfArray(ОснРазм)  + 1);
  CopyArray(НовПризн, ОснПризн, 1, LengthOfArray(ОснПризн) + 1);
  CopyArray(НовЦена,  ОснЦена,  1, LengthOfArray(ОснЦена)  + 1);

  ClearVariable(РАБ.ДИАПАЗОНЫ.НовСер);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовНач);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовКон);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовКол);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовРазм);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовПризн);
  ClearVariable(РАБ.ДИАПАЗОНЫ.НовЦена);
end;

------------------------------------------------------------------------------------------
-- Запуск процесса самогоноварения
Proc Обработка;
  while Разбивка do НовоеВСтарое; od;
  Сортировка; -- сортировка диапазонов
end;
------------------------------------------------------------------------------------------


-- Обработчики и события
------------------------------------------------------------------------------------------

-- Для тестов
Proc Button1_OnClick(Sender: String);
  ClearVariable(осн);
  ClearVariable(нов);
--  ClearVariable(Д_ОСН);
--  ClearVariable(Д_НОВ);
--  Д_ОСН[1] = 'АИ|30866|30875|10|7|ДЕНДОК.АИ_95_10|29.90|2';
--  Д_ОСН[2] = 'АИ|30868|30871|10|7|ДЕНДОК.АИ_95_10|29.90|2';
--  Д_ОСН[3] = 'АИ|30868|30871|10|7|ДЕНДОК.АИ_95_10|29.90|2';
--  Д_ОСН[4] = 'АИ|30868|30871|10|7|ДЕНДОК.АИ_95_10|29.90|2';
--  Д_ОСН[5] = 'АИ|30866|30875|10|7|ДЕНДОК.АИ_95_10|29.90|2';
--  Д_ОСН[6] = 'АИ|30866|30875|10|7|ДЕНДОК.АИ_95_10|29.90|2';

--  осн=LengthOfArray(Д_ОСН);
end;

Proc Button2_OnClick(Sender: String);
  --Обработка;
  --осн=LengthOfArray(Д_ОСН);
end;

Proc Button3_OnClick(Sender: String);
  --Сортировка;
end;




Конец
