БЛАНКСШАБЛОНОМ [07.11.2005] "справка по начисленной амортизации", РЕДАКТОР РПО_НАЧ_АМОРТ;
-- ЗАО "Агентство "Русспромоценка"
2-- Переменные и массивы бланка
НК20000:l;
УслДебет :s;
УслКредит:s;
СекцОбщ1         :Object;
СекцОбщ2         :Object;
СекцОтчЗ         :Object;
СекцОтчТ         :Object;
СекцОтчИ         :Object;
СекцОбщ3         :Object;
cbПроводить      :Object;
cbClosedModFob   :Object;
btnРасчет        :Object;
btnДопАна        :Object;
var fПровЭкспл   :Logical=False;
var Flag_onEnter :Logical;
var NewREC       :Logical=(CurrentState=crdusInserted);
var SelfCRD      :String="РПО_НАЧ_АМОРТ";
var кнОК         :String="ОК";
var кнЗкр        :String="Закрыть";
var ДатОтчСлед   :Date=if(ОтчМес=12, Dat(1, 1, ОтчГод+1), Dat(1, ОтчМес+1, ОтчГод)); -- дата следующего отчетного периода: дата проводок - конец отчетного периода
var ОтчМесСтр    :String=Месяц(ОтчМес); -- название месяца
var ОтчГодOld    :Integer;
var ПризнД_      :String=ПризнД;
var RR           :String="&";
var Пользов      :String;
БланкКОД:String;
var Вид_П        :Integer=[0];
var Вид_П1       :Integer=[0];
-- Вспомогательные массивы
var Buf[]        :String;
-- Таблица --
var NN[]         :String=Str($);
var ИМЯ[]        :String=РАБ.УПП.LIB.FormatAna   (Позиции[$].НФА, Вид_П, "наименования нет", "-");
var НомерИНВ[]   :String=РАБ.УПП.LIB.FormatInvAna(Позиции[$].НФА,Позиции[$].ИНВНОМ, Вид_П1, "б/н", chr(13));
--var НомерИНВ[]   :String=if(Позиции[$].ИНВНОМ="", "б/н", SubStr(Позиции[$].ИНВНОМ, 5, 255));
var СтоОст[]     :Numeric=Позиции[$].СтоБал-Позиции[$].АмоВсе; -- Остаточная стоимость
--
var ИменаСекций[]:String;
var BufField[]   :String;
var st[]    :String;
var st1[]   :String;
var BufColorBg[] :Integer;
var BufColorFo[] :Integer;

var ФильтрОС[]   :String;
var Аморт_СЧ8[]  :String;
var НФА_СЧ26[]   :String;
var СписокИНВ[]  :String;
var СписокНФА[]  :String;
var aНФА_ИМЯ[]   :String;
var aНФА_ИНВ[]   :String;
var aНОРМА[]     :Numeric;
var aКОЛ[]       :Numeric;
var aСТОБАЛ[]    :Numeric;
var aАМОМЕС[]    :Numeric;
var aАМОВСЕ[]    :Numeric;
var aЭКСПЛ[]     :Logical;
var aПРИЗН[]     :String;
var aСЧДЕБ[]     :String;
var aСЧКРЕ[]     :String;

2-- Общие процедуры и функции

var NN1[]:i;
Позиции1:i=ДлинаМассива(NN1);

--var ИМЯ1[]:s=Позиции[NN1[$]].ИМЯ
var ИМЯ1[]:s=ИМЯ[NN1[$]];
var НомерИНВ1[]:s=НомерИНВ[NN1[$]];
var Норма1[]=Позиции[NN1[$]].Норма    ;
var Кол1[]=Позиции[NN1[$]].Кол        ;
var СтоБал1[]=Позиции[NN1[$]].СтоБал  ;
var АмоМес1[]=Позиции[NN1[$]].АмоМес  ;
var АмоВсе1[]=Позиции[NN1[$]].АмоВсе  ;
var СтоОст1[]=СтоОст[NN1[$]]  ;
var Призн1[]:s=Позиции[NN1[$]].Призн  ;
var СЧдеб_СЧкре[]:S=Позиции[NN1[$]].СЧдеб+'/'+CHR(13)+Позиции[NN1[$]].СЧкре;
var гр6   :Numeric=SumOfArray(АмоМес1,Позиции1);
var гр7   :Numeric=SumOfArray(АмоВсе1,Позиции1);

Proc ОчиститьТаблицу;
 ClearVariable(ФильтрОС  );
 ClearVariable(Аморт_СЧ8 );
 ClearVariable(НФА_СЧ26  );
 ClearVariable(СписокИНВ );
 ClearVariable(СписокНФА );
 ClearVariable(aНФА_ИМЯ  );
 ClearVariable(aНФА_ИНВ  );
 ClearVariable(aНОРМА    );
 ClearVariable(aКОЛ      );
 ClearVariable(aСТОБАЛ   );
 ClearVariable(aАМОМЕС   );
 ClearVariable(aАМОВСЕ   );
 ClearVariable(aЭКСПЛ    );
 ClearVariable(aПРИЗН    );
 ClearVariable(aСЧДЕБ    );
 ClearVariable(aСЧКРЕ    );
end;

Proc ОчиститьТаблицу1;
 ClearVariable(NN1         );
 ClearVariable(ИМЯ1        );
 ClearVariable(НомерИНВ1   );
 ClearVariable(Норма1      );
 ClearVariable(Кол1        );
 ClearVariable(СтоБал1     );
 ClearVariable(АмоМес1     );
 ClearVariable(АмоВсе1     );
 ClearVariable(СтоОст1     );
 ClearVariable(Призн1      );
 ClearVariable(СЧдеб_СЧкре );
end;



Proc Очистить;
 ClearVariable(NN); ClearVariable(Buf); ClearVariable(ИМЯ); ClearVariable(НомерИНВ); ClearVariable(СтоОст);
 ОчиститьТаблицу;
end;


Func ВыборВидаТаблицы(State:Integer) :Integer;
var nn :Integer;
 ClearVariable(Buf);
 Buf[1]="код + наименование";
 Buf[2]="только код";
 Buf[3]="только наименование";
 Buf[4]="наименование + код";
 nn=Alternate("Выберите способ отображения аналитики", Buf, -1, State+1, 12);
 if nn=0: ^State; fi;
 ^(nn-1);
end;

2-- Процедуры и функции для расчета амортизации




Proc ЦветаПолей(ЦветКнопок:Integer);
var n,l :Integer;
 ClearVariable(BufField); ClearVariable(BufColorBg); ClearVariable(BufColorFo);
 n=InsertInArraySort(BufField,"КНОК");        InsertInArray(BufColorBg,n,ЦветКнопок);
 n=InsertInArraySort(BufField,"ОТЧГОД");      InsertInArray(BufColorBg,n,coAqua);
 n=InsertInArraySort(BufField,"ОТЧМЕССТР");   InsertInArray(BufColorBg,n,coTeal);
 n=InsertInArraySort(BufField,"РЕКВ.КОРИМЯ"); InsertInArray(BufColorBg,n,coTeal);
 n=InsertInArraySort(BufField,"ПРИЗНД_");     InsertInArray(BufColorBg,n,coTeal);
 n=InsertInArraySort(BufField,"НОРМА");       InsertInArray(BufColorBg,n,coTeal);
 n=InsertInArraySort(BufField,"ДОЛЖНИСП");    InsertInArray(BufColorBg,n,coAqua);
 n=InsertInArraySort(BufField,"ФИОИСП");      InsertInArray(BufColorBg,n,coAqua);
 n=InsertInArraySort(BufField,"ДАТАИСП");     InsertInArray(BufColorBg,n,coAqua);
 l=LengthOfArray(BufField);
 for n=1..l do
   if BufColorBg[n]=coTeal: BufColorFo[n]=coWhite;
   |  True: BufColorFo[n]=coBlack;
   fi;
 od;
end;

Proc ВнешнийВид(Проведено:Logical);
var i, j, цвFont, цвBack :Integer;
var СекцИмя : Object;
var ТЧ :Logical;
var tmp :String;
 tmp="СекцОтчТ"; i=1; j=2;
 if FindObject(tmp, СекцИмя):
   if not(Проведено): цвFont=coBlack; цвBack=coTransparent; ТЧ=True; else цвFont=coBlack; цвBack=coYellow; ТЧ=False; fi;
   СекцИмя.Cell(i, j, CellFontColor, цвFont); СекцИмя.Cell(i, j, CellBgColor, цвBack); СекцИмя.Cell(i, j, CellReadOnly, ТЧ);
 fi;
end;

Proc ТолькоЧтение(Flag:Logical);
var len, k, i, j, ik, jk, n, цвFont, цвBack :Integer;
var ТЧ :Logical;
var tmp :String;
var СекцИмя : Object;
 ClearVariable(ИменаСекций);
 ИменаСекций[1]="СекцОбщ1";
 ИменаСекций[2]="СекцОбщ2";
 ИменаСекций[3]="СекцОтчТ";
 ИменаСекций[4]="СекцОбщ3";
 len=LengthOfArray(ИменаСекций);
 ShowProgress(len, "Обработка данных...");
 Try
   for k=1..len do
     ProgressPos(k);
     if FindObject(ИменаСекций[k], СекцИмя):
       ik=asInteger(СекцИмя.RowsCount); jk=asInteger(СекцИмя.ColsCount);
       for i=1 .. ik do
         for j=1 .. jk do
           tmp=Up(asString(СекцИмя.Cell(i, j, CellContents, ""))); n=SearchInArray(BufField, tmp, True);
           if n<>-1:
             if Flag: цвFont=coBlack; цвBack=coTransparent; ТЧ=True; else цвFont=BufColorFo[n]; цвBack=BufColorBg[n]; ТЧ=False; fi;
             СекцИмя.Cell(i, j, CellFontColor, цвFont); СекцИмя.Cell(i, j, CellBgColor, цвBack); СекцИмя.Cell(i, j, CellReadOnly, ТЧ);
           fi;
         od;
       od;
     fi;
   od;
 Finally
   CloseProgress;
 end;
 ВнешнийВид(Flag);
 ClearVariable(ИменаСекций);
end;


Func TemplateSaveOK :Logical; -- проверка правильности ввода данных
 if ДатОтчСлед=1.1.100:
   Message("Укажите период отчета!", mtWarning);
   Template.Field="ОтчМесСтр"; 
   ^False;
 fi;
 if Позиции=0:
   Message("Сначала необходимо сделать расчет!", mtWarning);
   Template.Object="btnРасчет"; 
   ^False;
 fi;
 ^True;
end;

2-- События клеток
Func Field_onEnter(Field:String; Iter:Integer): Logical; -- на входе в клетку
var nn, Store :Integer;
var tmp :String;
var REC :Record;
 Flag_onEnter=False;
 if Field="кнОк"        : if ClosedModFob=False: EditorApply; fi; Close; ^False;
 |  Field="кнЗкр"       : if ClosedModFob=False: EditorCancel; fi; Close; ^False;
 |  Field="Вид_П"       : Вид_П =ВыборВидаТаблицы(Вид_П ); if Проводить: EditorApply; fi; ^False;
 |  Field="Вид_П1"      : Вид_П1=РАБ.УПП.LIB.ВыборВидаТаблицыИНВ(Вид_П1); if Проводить: EditorApply; fi; ^False;
 |  Field="Норма"       : if Позиции[Iter].НФА<>"" or Позиции[Iter].НФА<>" ":
                            REC=SignToRecord(Позиции[Iter].НФА);
                            OpenBlank("ИНФО.НФА.НФА", True, REC);
                          fi;
                          ^False;
 fi;
 ^True;
end;

Proc Field_onExit(Field:String; Iter:Integer); -- на выходе из клетки
end;

Func Field_OnValidateI(Field:String; Iter:Integer; Value:Integer): Logical;
 ^True;
end;

Func Год_onLookup(Sect:String; Row:Integer; Col:Integer; Cur:String) :String;
var nn, Store, Val :Integer;
var name :String;
 Template.HideEditor(False);
 ^"";
end;

Func Дата_onLookup(Sect:String; Row:Integer; Col:Integer; Cur:String) :String;
var dd: Date;
 ^"";
end;

Func Сотрудники_OnLookup(Sect:String; Row:Integer; Col:Integer; Cur:String): String;
var REC: Record;
var v1, v2, Sender, tmp :String;
 Template.HideEditor(False);
 REC=NIL;
 Sender=AsString(Template.Field);
 if Sender="ФИОИсп": tmp=ФИОИсп;
 fi;
 REC=OpenCardFile("СОТРУДНИКИ", "", SignToRecord(tmp), crdRecordOnly);
 if REC=NIL: ^Cur; fi;
 v1=GetCardFieldS("СОТРУДНИКИ", REC, "ДОЛЖНОСТЬ.ДОЛЖ");
 v2=GetCardFieldS("СОТРУДНИКИ", REC, "ФАМИЛИЯ")+" "+GetCardFieldS("СОТРУДНИКИ", REC, "ИНИЦИАЛЫ");
 if Sender="ДолжнИсп" or Sender="ФИОИсп": ДолжнИсп=v1; ФИОИсп=v2;
 fi;
 ^"";
end;

2-- События объектов
Func ВзятьДатуВводвЭксплуатЖурОст(СЧ26:String; КОДНФА:String; КОДИНВ:String; ddBeg:Date; ddEnd:Date) :Date;
var x, RO, OA, i, num,pp :Integer;
var sumTurn, sumBase :Numeric;
var REC :Record;
var dd, dd1, dd2 :Date;
var ANA,ss :String;
var OK :Logical;
 REC=NIL; dd=1.1.100; OK=False;
 ANA=СЧ26+"/00"+"{"+КОДНФА+"&"+КОДИНВ+"}";
 sumTurn=Turn(ANA, ddBeg, ddEnd);
-- for Transaction x=ANA, ddBeg, ddEnd, Reverse do
 for Transaction x=ANA, ddBeg, ddEnd  do
   REC=TransRecord(x);
   if TransCardFile(x)="РПО_ОСТ_НФА" and REC<>NIL then 
     i=ПроводНомерПризнака(x,'ММДД.');
     if i>0:ss=ПроводИмяПризн(x,i);
        i=ПроводНомерПризнака(x,'ГГ.');
        if i>0:-- собираем dd
           ss=ВыделитьСлово(3,ss,'.')+'.'+ВыделитьСлово(2,ss,'.')+'.';
           ss=ss+ВыделитьСлово(2,ПроводИмяПризн(x,i),'.');
           dd=Строкувдату(ss);
         | true:ss='';
        fi;
     fi;
     if длина(ss)>1:
        ^dd;
     fi;
     RO=OpenWorkArea("РПО_ОСТ_НФА", "", "UKey="+RecordToString(REC));
     Try
       if Records(RO)=1:
         OA=OpenArray(RO, 1, "ПОЗИЦИИОС", "", "Match(СЧНФА, '"+СЧ26+"') and НФА='"+КОДНФА+"' and УЧНОМ='"+КОДИНВ+"'");
         num=Records(OA);
         if num>0:
           for i=1 to num do
             sumBase=GetFieldN(OA, i, "СУМНФА");
             if sumTurn=sumBase: 
               dd1=GetFieldD(OA, i, "ДЭКСПЛ");
               dd2=GetFieldD(OA, i, "ДУЧЕТ");
               if dd1<dd2 and dd1>1.1.1900: dd=dd1;
               |  dd1>dd2 and dd2>1.1.1900: dd=dd2;
               else dd=1.1.100;
               fi;
               if dd<>1.1.100: OK=True; Break; fi;
             fi;
           od;
         fi;
         CloseWorkArea(OA);
       fi;
     Finally
       CloseWorkArea(RO);
     end;

     if OK: Break; fi;
   fi;
 od;
 if dd<1.1.1800:
   ANA='+'+СЧ26+"/*&~"+СЧ26+"{"+КОДНФА+"&"+КОДИНВ+"}";  -- отработать принятие к учету нового ОС и б/у, для нового - дата проводки, а для б/у?
   for Transaction x=ANA, ddBeg, ddEnd  do
     pp=pos('ДЭКСПЛ=',TransComment(x));
     if pp>0:dd=stringtodate(substr(TransComment(x),pp+7,10));
      | true:
        i=ПроводНомерПризнака(x,'ММДД.');
        if i>0:ss=ПроводИмяПризн(x,i);
           i=ПроводНомерПризнака(x,'ГГ.');
           if i>0:-- собираем dd
              ss=ВыделитьСлово(3,ss,'.')+'.'+ВыделитьСлово(2,ss,'.')+'.';
              ss=ss+ВыделитьСлово(2,ПроводИмяПризн(x,i),'.');
              dd=Строкувдату(ss);
            | true:ss='';
           fi;
        fi;
     fi;
     if dd<1.1.1800:dd=TransDate(x);fi;
   od;
   ^dd;
 fi;
--       if TransCardFile(k)="РПО_ОСТ_НФА":
--          tmp1=' '+transComment(k);
--          tmp1=trim(ВыделитьСлово(2,tmp1,'/'));
--          dt1=СтрокуВдату(tmp1);
--          if dt1>1.1.100:
--             ДАТ_ВЭКСП=dt1;
--          fi;
--       fi;

 ^dd;
end;


Proc btnРасчет_onClick(Sender:String);
 var z,k:i;
 var ll:l;
 var dexpl:d;
 var ss:s;
 ОчиститьТаблицу1;
 for z=1..Позиции do
   nn1[z]=z;
 od;

 УслДебет=trim(УслДебет);
 УслКредит=trim(УслКредит);

 if УслДебет<>'' or УслКредит <>'':
   for z=1..Позиции do
    ll=true;
    if УслДебет<>'':ll=ll and Соотв(Позиции[z].СЧдеб,УслДебет);fi;
    if УслКредит<>'':ll=ll and Соотв(Позиции[z].СЧкре,УслКредит);fi;
    if not ll:
       k=ПоискВмассиве(nn1,z);
       if k>0:
         УдалитьИзМассива(nn1,k);
       fi;
     | true:
       if НК20000:
          if Позиции[z].СтоБал<=40000:
             ss=SubStr(Позиции[z].СЧкре,1,23)+SubStr(Позиции[z].НФА,5,7)+'310';
             dexpl=ВзятьДатуВводвЭксплуатЖурОст(ss, Позиции[z].НФА, Позиции[z].ИНВНОМ, 1.1.100, ДАТОПЕР);
             if dexpl>30.11.2007:
                k=ПоискВмассиве(nn1,z);
                if k>0:
                  УдалитьИзМассива(nn1,k);
                fi;
             fi;
          fi;
       fi;
    fi;
   od;
   exit;
 fi;

-- if УслДебет<>'' and УслКредит <>'':
--   for z=1..Позиции do
--    if not(Соотв(Позиции[z].СЧдеб,УслДебет) and Соотв(Позиции[z].СЧкре,УслКредит)):
--     k=ПоискВмассиве(nn1,z);
--     if k>0:
--       УдалитьИзМассива(nn1,k);
--     fi;
--    fi;
--   od;
--   exit;
-- fi;
-- if УслДебет<>'':
--   for z=1..Позиции do
--    if not(Соотв(Позиции[z].СЧдеб,УслДебет)):
--     k=ПоискВмассиве(nn1,z);
--     if k>0:
--       УдалитьИзМассива(nn1,k);
--     fi;
--    fi;
--   od;
--   exit;
-- fi;
-- if УслКредит <>'':
--   for z=1..Позиции do
--    if not(Соотв(Позиции[z].СЧкре,УслКредит)):
--     k=ПоискВмассиве(nn1,z);
--     if k>0:
--       УдалитьИзМассива(nn1,k);
--     fi;
--    fi;
--   od;
--   exit;
-- fi;
 message('Расчет завершен');
end;


2-- События шаблона
Proc Template_onOpen(Create:Logical);
var tmp :String;
var Цв :Integer;
 EnableCommands(False, cmDublRec);
 Цв=РАБ.УПП.LIB.Цвет(236, 233, 216);
 СекцОбщ1.Cell(2, 2, CellBgColor, Цв);
 СекцОбщ1.Cell(2, 4, CellBgColor, Цв);
 РАБ.НАСТР_ПЕЧАТЬ.Cfg(PlanVar("НФА")+"\Настройки\","RPO_amort_000.cfg");
 ЦветаПолей(Цв);
 tmp=UserName(AliasName(SelfCRD));
 Пользов=if(tmp<>"", "Пользователь - "+tmp, "Пользователь локальной версии");
 БланкКОД=РАБ.НФА.B01.БланкИмя;
end;

Proc Template_onClose(Destroy:Logical); -- При закытии бланка
 ClearVariable(BufField); ClearVariable(BufColorBg); ClearVariable(BufColorFo);
 Очистить;
 if CurrentState=CrdusUndefined: Destroy=True; fi;
end;

Proc Template_onCancel; -- при отмене редактирования шаблона
 Очистить;
 if CurrentState=CrdusUndefined: 
   Message("Была произведена отмена редактирования!^MВ картотеке нет записей, бланк будет закрыт.", mtInformation);
   Close;
 fi;
end;

Proc Template_onRead; -- При считывании шаблона
var tmp :String;
var z:i;
 Очистить;
 ОчиститьТаблицу1;
 for z=1..Позиции do
   nn1[z]=z;
 od;
 ТолькоЧтение(true);
end;

Func Template_OnValidate: Logical; -- при проверке шаблона
 ^false;
end;

КОНЕЦ