type 
  TDoubleArray= array   of  double;
  TIntegerArray= array   of  integer;

 //получение раскроя лент на заданные куски с минимальной длиной отрезанных лент (нетронутые не учитываются) 
 //Рекурсия. Динамическое программирование 
 //куски и ленты нумеруются с 0 
 //Number - очередной рассматриваемый кусок (в начале выбирается 0) 
 //Lines - массив длин лент 
 //Pieces - массив длин кусков 
 //LinearNumbers - массив указания куска в разрезе: j-й кусок отрезается от LinearNumbers[j] 
 function  Cutting( const  Number:integer;  const  Lines,Pieces:TDoubleArray;  var  LinearNumbers:TIntegerArray):boolean;
 var 
  i,j,n,m:integer;
  Remnants:TDoubleArray;    //остатки лент 
  LinearNumbers2:TIntegerArray;  //аналог LinearNumbers для передачи в рекурсии 
  MinSum,Sum:double;  //текущай и минимальная длина остатков лент 
 begin 
  n:=Length(Lines);
  m:=Length(Pieces);
  MinSum:= 0 ;

   //инициализация LinearNumbers2 элементами LinearNumbers 
   //расчет текущих остатков лент 
  SetLength(Remnants,n);
  SetLength(LinearNumbers2,m);
   for  i:= 0   to  n- 1   do 
   begin 
    Remnants:=Lines[i];
    MinSum:=MinSum+Lines[i];
   end ;
   for  i:= 0   to  Number- 1   do 
   begin 
    Remnants[LinearNumbers[i]]:=Remnants[LinearNumbers[i]]-Pieces[i];
    LinearNumbers2[i]:=LinearNumbers[i];
   end ;
  SetLength(LinearNumbers, 0 );

  Result:=false;

   [i]//перебор возможных позиций для очередного куска 
   for  i:= 0   to  n- 1   do 
   begin 
     if  Remnants>Pieces[Number]  then    [i]//кусок умещается в остаток ленты 
     begin 
      LinearNumbers2[Number]:=i;
       if  Number<m- 1   then    //если это не последний кусок, то пердаем в рекурсии 
        Result:=Cutting(Number+ 1 ,Lines,Pieces,LinearNumbers2)
       else 
        Result:=true;
       if  Result  then    //если удалось получить разбиение, то посчитаем длину остатков 
       begin 
         //получение остатков после рекурсии 
         for  j:=Number  to  m- 1   do 
          Remnants[LinearNumbers2[j]]:=Remnants[LinearNumbers2[j]]-Pieces[j];
         //сумма длин остатков 
        Sum:= 0 ;
         for  j:= 0   to  n- 1   do 
           if  Lines[j]>Remnants[j]  then 
            Sum:=Sum+Remnants[j];
         //проверка на минимальность     
         if  MinSum<Sum  then 
         begin 
          MinSum:=Sum;
          LinearNumbers:=LinearNumbers2;
         end ;
       end ;
     end ;
   end ;
 end ;