БЛАНКСШАБЛОНОМ[20.04.2006] "Лечение проблемы исчерпания лимита записей в подтаблице";
-- Редакция ЗАО "Агентство 'Русспромоценка'"
2-- Переменные
btnClose     :Object;
btnUse       :Object;
WorkCRD      :String;
WorkTAB      :String;
MaxNumCRD    :Integer;

var Buf[]    :String;
var BufNam[] :String;
var BufTxt[] :String;
var BufREC[] :Record;
var WorkREF  :Record;

Proc Очистить;
 ClearVariable(Buf); ClearVariable(BufNam); ClearVariable(BufTxt); ClearVAriable(BufREC);
end;

Func ВыборCRD(PrevValue:String) :String;
var Режим :Logical;
var len, i, nn, xx, j, k :Integer;
var name, type, crdname, tmp, PrevTMP :String;
 Режим=AutoRefresh;
 ToggleAutoRefresh(False);
 ShowProgress(0, "Связывание журналов...");
 Try
   Refresh(False);
   len=JournalsCount;
   if len>0:
     Очистить;
     nn=GetCardFileNames("*", Buf, False, True, "");
     if nn>0:
       ShowProgress(nn, "Подготовка журналов...");
       for i=1 to nn do
         ProgressPos(i);
         tmp=Buf[i];
         j=InsertInArraySort(BufNam, SubStr(tmp, 1, Pos(" --", tmp)-1));
         InsertInArray(BufTxt, j, SubStr(tmp, Pos(" -- ", tmp)+4, 255));
       od;
     fi;
     ShowProgress(len, "Обработка журналов...");
     ClearVariable(Buf);
     xx=0; k=1;
     PrevTMP="";
     for i=0 to len do --нумерация журналов в списке журналов начинается с нуля
       ProgressPos(i);
       name=JournalName(i);
       type=Up(JournalType(name));
       if type="КАРТ" :
          xx=xx+1;
          crdname=JournalCardFile(name);
          j=SearchInArray(BufNam, crdname, True, 1);
          tmp="";
          if j>0: tmp=" --"+BufTxt[j]; fi;
          tmp=crdname+tmp;
          if SearchInArray(Buf, tmp, True, 1)=-1: 
            InsertInArraySort(Buf, tmp);
            if crdname=Up(PrevValue): PrevTMP=tmp; fi;
          fi;
       fi;
     od;
   else
     Message("Журналы-картотеки не обнаружены!", mtError);
     ^"";
   fi;
 Finally
   CloseProgress;
   ToggleAutorefresh(Режим);
 end;
 len=LengthOfArray(Buf);
 if len>0:
   if PrevTMP<>"": j=SearchInArray(Buf, PrevTMP, True, 1); if j>0: k=j; fi; fi;
   nn=AlternateTree("Выберите картотеку", Buf, -1, k, 12, " ", "картотека", "примечание", -1, False);
   if nn>0:
     ^(SubStr(Buf[nn], 1, Pos(" --", Buf[nn])-1));
   else
     ^PrevValue;
   fi;
 else
   Message("Журналы-картотеки не обнаружены!", mtError);
   ^"";
 fi;
end;

Func ВыборTAB(PrevValue:String) :String;
var nn, k :Integer;
 if WorkCRD="" or not ExistsCardFile(WorkCRD): Message("НЕ выбрана картотека для обработки!", mtWarning); ^PrevValue; fi;
 ClearVariable(Buf);
 nn=GetCardFileFields(WorkCRD, Buf, mtlSUBTAB);
 if nn>0:
   if nn=1: 
     ^(Buf[1]);
   else
     k=SearchInArray(Buf, PrevValue, False, 1);
     if k<1: k=1; fi;
     nn=Alternate("Выберите подтаблицу", Buf, -1, k, 12);
     if nn=0: ^PrevValue; fi;
     ^(Buf[nn]);
   fi;
 fi;
end;

Func ЕстьTAB(TAB:String) :Logical;
var nn, k :Integer;
 if WorkCRD="" or not ExistsCardFile(WorkCRD): ^False; fi;
 ClearVariable(Buf);
 nn=GetCardFileFields(WorkCRD, Buf, mtlSUBTAB);
 k=0;
 if nn>0: k=SearchInArray(Buf, TAB, False, 1); fi;
 if k>0: ^True; else ^False; fi;
end;

Func ВыборMaxNumCRD(PrevValue:Integer) :Integer;
var num, k :Integer;
 ClearVariable(Buf);
 for k=1 to 6 do Buf[k]="Записей в подтаблице - "+Str(50*k); od;
 for k=4 to 10 do Buf[k+3]="Записей в подтаблице - "+Str(100*k); od; -- k+3 = k+6-3; 6 - LengthOfArray(Buf)
 if PrevValue>300 and PrevValue<1001 : k=3+Int(PrevValue/100);
 |  PrevValue>0   and PrevValue<301  : k=Int(PrevValue/50);
 else k=1;
 fi;
 num=Alternate("Настройте количество записей в подтаблице...", Buf, -1, k, 12);
 if num>0 and num<7  : ^(num*50);
 |  num>6 and num<14 : ^((num-3)*100);
 else ^PrevValue;
 fi;
end;

Proc ЛечениеЛимитаЗаписей;
var RO, R1, OA, A1, i, j, len, num, nn, cop, xx, zz, k, wrk, ii, jj :Integer;
var Режим, Work :Logical;
var REC: Record;
var MskFtr :String;
 if WorkCRD="" or not ExistsCardFile(WorkCRD): Message("НЕ выбрана картотека для обработки!", mtWarning); Exit; fi;
 if WorkTAB="" or not ЕстьTAB(WorkTAB): Message("НЕ выбрана подтаблица для обработки!", mtWarning); Exit; fi;
 if not (MaxNumCRD>0 and MaxNumCRD<1001): Message("НЕ выбрано количество записей в подтаблице!", mtWarning); Exit; fi;
 nn=EnqOkCancel("Выполнение данной процедуры может привести^Mк необратимым (в том числе и к ошибочным) результатам.^M^MПродолжить?^M^MОбязательно сделайте архивную копию картотеки!", mtWarning);
 if nn=cmCancel: Exit; fi;
 if WorkREF<>NIL:
   nn=Enquiry("Выберите действие", "Обнаружен фильтр по записи.^MТребуется обработать...", "Все записи;Запись фильтра;Отмена", mtInformation);
   if nn=1: MskFtr="";
   |  nn=2: MskFtr="UKEY="+RecordToString(WorkREF);
   else Exit;
   fi;
 fi;
 Очистить;
 Режим=AutoRefresh;
 ToggleAutoRefresh(False);
 ShowProgress(0, "Подготовка...");
 RO=OpenWorkArea(WorkCRD, "", MskFtr);
 R1=OpenWorkArea(WorkCRD, "", "1=0");
 Try
   len=Records(RO);
   Work=False;
   if len>0:
     ShowProgress(len, "Обработка картотеки...");
     num=0;
     for i=1 to len do
       ProgressPos(i);
       REC=NIL;
       OA=OpenArray(RO, i, WorkTAB, "", "");
       nn=Records(OA);
       if nn>MaxNumCRD: Work=True; REC=GetRecordKey(RO, i); fi;
       CloseWorkArea(OA);
       if Work and REC<>NIL: num=num+1; BufREC[num]=REC; fi;
     od;
   fi;
   if not Work: Message("Нет записей для обработки!", mtWarning); Exit; fi;
   len=LengthOfArray(BufREC);
   if len>0:
     ShowProgress(len, "Исправляем...");
     for i=1 to len do
       ProgressPos(i);
       SetFilter(R1, "UKEY="+RecordToString(BufREC[i]));
       if Records(R1)=1:
         OA=OpenArray(R1, 1, WorkTAB, "", "");
         num=Records(OA);
         CloseWorkArea(OA);
         cop=Int(num/MaxNumCRD);
         zz=MaxNumCRD+1;
         xx=zz+MaxNumCRD;
         if cop>0:
           for j=1 to cop do -- сколько раз вставлять
             OA=OpenArray(R1, 1, WorkTAB, "", "");
             BeginChanging(RO);
             Try
               BeginChanging(R1, False);
               Try
                 k=num;
                 while k>0 do
                   if not (k>=zz and k<xx): DeleteRecord(OA, k); fi;
                   k=k-1;
                 od;
                 zz=zz+MaxNumCRD;
                 if xx+MaxNumCRD>num: xx=num+1; else xx=xx+MaxNumCRD; fi;
                 wrk=InsertRecord(RO);
                 CopyRecord(R1, RO, 1, wrk);
                 CancelChanging(R1);
               Except
                 CancelChanging(R1);
                 Raise;
               end;
               ClearVariable(Buf);
               jj=GetCardFileFields(WorkCRD, Buf, mtlSUBTAB);
               for ii=1 to jj do
                 if Up(Buf[ii])<>Up(WorkTAB):
                   A1=OpenArray(RO, wrk, Buf[ii], "", "");
                   if Records(A1)>0: DeleteAllRecords(A1); fi;
                   CloseWorkArea(A1);
                 fi;
               od;
               EndChanging(RO);
             Except
               CancelChanging(RO);
               Raise;
             end;
             CloseWorkArea(OA);
           od;
           BeginChanging(R1);
           Try
             OA=OpenArray(R1, 1, WorkTAB, "", "");
             k=num;
             while k>MaxNumCRD do
               DeleteRecord(OA, k);
               k=k-1;
             od;
             CloseWorkArea(OA);
             EndChanging(R1);
           Except
             CancelChanging(R1);
             Raise;
           end;
         fi;
       fi;
     od;
   fi;
   Message("Выполнение завершено!", mtInformation);
 Finally
   CloseWorkArea(R1);
   CloseWorkArea(RO);
   CloseProgress;
   ToggleAutoRefresh(Режим);
 end;
end;

Func ВыборКонкретнойЗаписиКартотеки(OldREC:Record) :Record;
var NewREC: Record;
 if WorkCRD="" or not ExistsCardFile(WorkCRD): Message("НЕ выбрана картотека для обработки!", mtWarning); ^OldREC; fi;
 NewREC=OpenCardFile(WorkCRD, "--", OldREC, crdRecordOnly);
 if NewREC<>NIL and NewREC<>OldREC: ^NewREC; else ^OldREC; fi;
end;

2-- События объектов
Proc btnOnClick(Sender:String); -- объекты при нажатии
 if Sender="btnUse"   : ЛечениеЛимитаЗаписей;
 |  Sender="btnClose" : Close;
 fi;
end;

2-- События клеток
Func Field_onEnter(Field:String; Iter:Integer): Logical; -- на входе в клетку
 if Field="WorkCRD"   : WorkCRD=ВыборCRD(WorkCRD); WorkREF=NIL; WorkTAB=""; ^False;
 |  Field="WorkTAB"   : WorkTAB=ВыборTAB(WorkTAB); WorkREF=NIL;             ^False;
 |  Field="MaxNumCRD" : MaxNumCRD=ВыборMaxNumCRD(MaxNumCRD); ^True;
 |  Field="WorkREF"   : WorkREF=ВыборКонкретнойЗаписиКартотеки(WorkREF); ^False;
 fi;
 ^True;
end;

Proc Field_onExit(Field:String; Iter:Integer); -- на выходе из клетки
 if Field="WorkCRD" : if WorkCRD="":  WorkREF=NIL; WorkTAB=""; fi;
 |  Field="WorkTAB" : if WorkTAB="":  WorkREF=NIL; fi;
 |  Field="WorkREF" : WorkREF=NIL;
 fi;
end;

2-- События шаблона
Proc Template_OnOpen(Create:Logical); -- при открытии шаблона
 if Trim(WorkCRD)="": 
   WorkCRD="РПО_ОСТ_НФА";
   WorkTAB="ПОЗИЦИИОС";
 fi;
 if MaxNumCRD<1 or MaxNumCRD>1000: MaxNumCRD=300; fi;
 WorkREF=NIL;
 Очистить;
end;

Proc Template_OnClose(Destroy:Logical); -- при закрытии шаблона
 WorkREF=NIL;
 Очистить;
end;

КОНЕЦ -- конец бланка