************
*
* Программа..:  Самое разное для всех модулей должно лежать здесь
* Автор......:  Кравцов и все, все, все
* Назначение.:
*
******

// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.

#include "inkey.ch"
#include "s_refer.ch"
#include "s_public.ch"
#ifndef __HARBOUR__
#include "ctscan.ch"
#else
#include "ctscan_h.ch"
#endif
#include "fileio.ch"
#DEFINE COL_SHEADR   IF(INST_COLOR,'gr+/b*,w+/n,,,w+/b*','n/w,w+/n,,,n/w')
#DEFINE xPict SummaPic(CURR_MAIN, _SUMMA_LEN)
#define COL_REGIS 'N/W,W+/N'
#define CR   chr(13)
#define LF   chr(10)
#define CRLF CR + LF
STATIC LenSeek:=10
// Операции с aIn
#DEFINE SeekPos(xVal)  ASCAN(aString,PADR(xVal,10))
#DEFINE aSeekPos(aHeadString)   (aString := SetSeekPos(aHeadString))
MemVar lValidEdit, cValidPath, nMyCurs

******************
FUNCTION SetWPrinter(nMode,nStr, nCol,cDest)
******************
//nMode 0 - вывести на экран инф о принтере и setkey
//      1 - выбор принтера
//      2 - закрытие принтера
LOCAL aSetKey,aSet, oldCur, cScr
STATIC cScrWPrin, cPrn, bF10
PRIVATE GetList:={}, pPrn
DO CASE
   CASE nMode = 0
      cScrWPrin:=SaveSCREEN(nStr,10,nStr+4,71)
//      ShadowBox("Принтер для печати ",nStr,20,nStr+2,58,COL_SHEADR)
      cPrn:=m->PRN0_WPRINTER
      &cDest:=cPrn
    //  @nStr,22 SAY LEFT(cPrn,35)  COLOR COL_SHEADR
   //   @nStr+1,31 SAY 'F10:Выбор принтера'  COLOR COL_SHEADR
      bF10:=SETKEY(K_F10,{||SetWPrinter(1,nStr,nCol,cDest)})
   CASE nMode = 1
      if File(PRN0_BEST_PRINT+'PrnList.dbf')
         aSetKey:=SaveSetKey()
         //aSet:=SaveSet()
         dbPush()
         NetUse( "PrnList", PRN0_BEST_PRINT+'PrnList.dbf')
         PrnList->(MakeRefer("Printer","[ Справочник принтеров ]",2,;
         {"Название принтера"},;
         {4,34,12},COL_REFER,{"PrnList->PRINTER"},{"pPrn"},,;
         {{||Left(PrnList->Printer,40)}},;
         ,;
         ,,,,,,,,,,'F2:Справочник принтеров',,,,,'cFind$UPPER(TRIM(PrnList->PRINTER ))' ))
         cScr:=SAVESCREEN(nStr+2,10,nStr+5,69)
         ShadowBox("Принтер для печати ",nStr+2,10,nStr+4,68,COL_SHEADR)
         m->pPrn:=cPrn
         @nStr+3,12 REFER 'PRINTER' GET pPrn PICTURE '@S54' COLOR COL_GET
         oldCur:=SETCURSOR(1)
         READ
         SETCURSOR(oldCur)
         RESTSCREEN(nStr+2,10,nStr+5,69,cScr)
         IF LASTKEY()#K_ESC
            cPrn:=m->pPrn
            &cDest:=cPrn
            IF TYPE('nRowPrn')='N'.AND.TYPE('nColPrn')='N'.AND.TYPE('nDlPrn')='N'
               @m->nRowPrn,m->nColPrn SAY LEFT(m->pPrn,m->nDlPrn) COLOR COL_SHEADR
            ELSE
               @nStr,nCol SAY LEFT(m->pPrn,30) COLOR COL_SHEADR
            ENDIF
         ENDIF
         PrnList->(dbCloseArea())
         dbPop()
         //RestSet(aSet)
         RestSetKey(aSetKey)
      end
   CASE nMode = 2
      RestSCREEN(nStr,10,nStr+4,71,cScrWPrin)
      SETKEY(K_F10,bF10)
   OTHERWISE
ENDCASE

RETURN .T.


******************
FUNCTION PutWinPrint(aData)
******************
LOCAL lOpen:=.F., cRes:='',i

IF SELECT('RepTasks')=0
   (ALIAS())->(NetUse('RepTasks',PRN0_BEST_PRINT+'RepTasks'))
   lOpen:=.T.
ENDIF
FOR i:=1 TO LEN(aData)
   DO CASE
      CASE VALTYPE(aData[i,2])='C'
         cRes+=aData[i,1]+"={s '"+STRTRAN(aData[i,2],"'","''")+"'}"+CRLF
      CASE VALTYPE(aData[i,2])='N'
         cRes+=aData[i,1]+"={n "+STR(aData[i,2],20,5)+"}"+CRLF
      CASE VALTYPE(aData[i,2])='D'
         cRes+=aData[i,1]+"={d '"+TRANSFORM(DTOS(aData[i,2]),'@R 9999-99-99')+"'}"+CRLF
      CASE VALTYPE(aData[i,2])='L'
         cRes+=aData[i,1]+"={b "+IF(aData[i,2],"T","F")+"}"+CRLF
      OTHERWISE
         SayError('Неправильный тип параметра')
   ENDCASE
NEXT
IF RepTasks->(AddRec(.f.))
   RepTasks->NNOper:=IncStepW('OperWinTask')
   RepTasks->Task:=cRes
   RepTasks->(dbUnLock())
ENDIF

IF lOpen
   RepTasks->(dbCloseArea())
ENDIF
RETURN cRes

//----------------------------------------------------------------------------//
 STATIC Function IncStepW(cInc)
//----------------------------------------------------------------------------//
// возвращает следущий номер операции
// cInc - уникальное (для треб. счетчика) имя
LOCAL nNoper
   cInc:=PADR(cInc,10)
   (ALIAS())->(NetUse( "WinCash", PRN0_BEST_PRINT+'Win_Cash.dbf'))
   WinCash->(dbPush(,,'Name="'+UPPER(cInc)+'"'))
   IF WinCash->(EOF())
      WinCash->(AddRec(.f.))
      WinCash->Name:=UPPER(cInc)
      WinCash->(dbUnLock())
   ENDIF
   IF WinCash->(RecLock(,.f.))
      nNoper:=WinCash->Param+1
      IF nNoper > 9999999
         nNoper:=1
      ENDIF
      WinCash->Param:=nNoper
      WinCash->(dbUnLock())
   ELSE
      SayError('Ошибка формирования уникального номера !')
      nNoper:=-1
   ENDIF
   WinCash->(dbPop())
   WinCash->(dbCLOSEAREA())
RETURN nNoper


//----------------------------------------------------------------------------//
     FUNCTION WinPrint(cAlias,cOrder,cScope,cFilt,aData)
//----------------------------------------------------------------------------//
// Печать по шаблонам
// cScope - фильтр для списка шаблонов
LOCAL nColRec := 0
LOCAL nWin := WSELECT()
LOCAL aSet := (WSELECT(0),SaveSet())
LOCAL aKey := SaveSetKey()
LOCAL cHead,i,j,nStr:=1, oGet, cPict, cScr,nLeftR
LOCAL aMain, aDescr
LOCAL bEnter:=SETKEY(K_ENTER)
LOCAL aCommon:={;
                 {'USER_CODE',m->Global_Set[2]},;
                 {'USER_NAME',m->Global_Set[3]},;
                 {'LBL_CODE',m->LBL_CODE}   ,;
                 {'LBL_NAME',m->LBL_NAME}   ,;
                 {'LBL_BOSS2',m->LBL_BOSS2} ,;
                 {'LBL_BOSS',m->LBL_BOSS}   ,;
                 {'LBL_SHEF2',m->LBL_SHEF2} ,;
                 {'LBL_SHEF',m->LBL_SHEF}   ,;
                 {'LBL_INDEKS',m->LBL_INDEKS},;
                 {'LBL_ADRES',m->LBL_ADRES},;
                 {'LBL_TEL',m->LBL_TEL}      ,;
                 {'LBL_FAX',m->LBL_FAX}      ,;
                 {'LBL_OKPO',m->LBL_OKPO}    ,;
                 {'GlobalVal',m->GLOBALVALUTA},;
                 {'GlobalVal_ACCURACY',M->CURR_MAIN}   ;
                }

PRIVATE GetList:={}
PRIVATE pPrinter
PRIVATE aYes:={{.T.,'Да '},{.F.,'Нет'}}
PRIVATE nRowPrn,nColPrn,nDlPrn
PRIVATE aIn
//lbl_wpath:='ffffffffff'

cHead := "Шаблоны печати"

IF(ValType(cAlias) = "C",,cAlias := "MVDOC")

IF TYPE('PRN0_WIN_PRINT')='N'.AND. m->PRN0_WIN_PRINT = 2 .AND. TYPE('PRN0_BEST_PRINT')='C'.AND. !EMPTY(m->PRN0_BEST_PRINT)
qPush()
dbPush(cAlias,cOrder,,IF(EMPTY(cFilt).AND.EMPTY(cScope),'',{cFilt,cScope}))
qPush()

BEGIN SEQUENCE
   dbSetFilter({||Field->WIN='1'},"WIN='1'")
   dbGoTop()
   DbEval({|| nColRec++ },{|| .T. },ScopeBlock())
   dbGoTop()
   IF nColRec = 0
      SayError('Нет настроенных шаблонов печати')
      BREAK
   ENDIF
   IF nColRec > 1
      SetKey(K_ENTER,{|| 0 })
      ShadowBox("[ "+ALLTRIM(cHead)+" ]",6,22,22,22+FieldSize(FieldPos("NAME"))+IF((cAlias)->(FIELDPOS('CODE'))=0,3,7),COL_REFER)
      ScrTitul(24,"Enter:Выбоp фоpмы ")
      InitList(7,21,FieldSize(FieldPos("NAME"))+IF((cAlias)->(FIELDPOS('CODE'))=0,0,6),{{{|| IF((cAlias)->(FIELDPOS('CODE'))=0,'',(cAlias)->CODE) },1},{{|| (cAlias)->NAME },IF((cAlias)->(FIELDPOS('CODE'))=0,1,5)}},,,,,,,,{|| .F.},,,,,,,{|| COL_REFER },,23,,,COL_REFER)
   ENDIF
   SetKey(K_ENTER,bEnter)


   IF LastKey() != K_ESC
      aDescr:=FIELD->Descript
      SetWPrinter(0,18,22,'pPrinter')
      BEGIN SEQUENCE
      IF VALTYPE(aDescr)='A'
         AADD(aDescr,NIL)
         aINS(aDescr,1)
         aDescr[1]:={'PrinterCopies','Количество копий','N',3,0,1,.T.}
      ELSE
         aDescr:={{'PrinterCopies','Количество копий','N',3,0,1,.T.}}
      ENDIF
      aIn:=ARRAY(LEN(aDescr))
      j:=0
      cScr:=SAVESCREEN(5,0,19,79)

      FOR i:=1 TO LEN(aDescr)
         IF j=0
            SayRamka("[ Входные параметры ]"+IF(LEN(aDescr)>11," ["+STR(nStr,2)+"]",""),5,@nLeftR,i,aDescr)
         ENDIF
         j++
         DO CASE
            CASE aDescr[i,3]='C'
               IF LEN(aDescr[i])>5 .AND. !EMPTY(aDescr[i,6])
                  aIn[i]:=PADR(aDescr[i,6],aDescr[i,4])
               ELSE
                  aIn[i]:=SPACE(aDescr[i,4])
               ENDIF
               cPict:='@K'
               IF 25+aDescr[i,4]+1 > 70
                  cPict+='S45'
               ENDIF
            CASE aDescr[i,3]='N'
               IF LEN(aDescr[i])>5 .AND. !EMPTY(aDescr[i,6])
                  aIn[i]:=aDescr[i,6]
               ELSE
                  aIn[i]:=0
               ENDIF
               cPict:=REPLICATE('9',aDescr[i,4])
               IF aDescr[i,5]>0
                  cPict:=STUFF(cPict,aDescr[i,4]-aDescr[i,5],1,'.')
               ENDIF
            CASE aDescr[i,3]='D'
               IF LEN(aDescr[i])>5 .AND. !EMPTY(aDescr[i,6])
                  aIn[i]:=aDescr[i,6]
               ELSE
                  aIn[i]:=CTOD('')
               ENDIF
               cPict:=NIL
            CASE aDescr[i,3]='L'
               IF LEN(aDescr[i])>5 .AND. !EMPTY(aDescr[i,6])
                  aIn[i]:=aDescr[i,6]
               ELSE
                  aIn[i]:=.F.
               ENDIF
               cPict:=NIL
            OTHERWISE
         ENDCASE
         @5+j,nLeftR+2 SAY PADR(aDescr[i,2],25) COLOR COL_SHEADR
         oGet:=GETNEW(5+j,COL()+1,&("{|x|IF(x=NIL,aIn["+STR(i,2)+"],aIn["+STR(i,2)+"]:=x)}"),'aIn['+STR(i,2)+']',,COL_GET)
         IF aDescr[i,3]='L'
            oGet:block := &("{ |x| RotateBlock(x,aYes,'aIn["+STR(i,2)+"]')}")
            oGet:reader := { |oGet| RotateAndReader( oGet,aYes) }
         ENDIF
         IF !EMPTY(cPict)
            oGet:picture:=cPict
         ENDIF
         IF LEN(aDescr[i])>6 .AND. VALTYPE(aDescr[i,7])='L' .AND. !aDescr[i,7]
            oGet:PreBlock:={||.F.}
         ENDIF
         AADD(GetList,oGet)
         oGet:display()
         IF j>10 .OR. i=LEN(aDescr)
            SET CURSOR ON
            READ
            SET CURSOR OFF
            IF LASTKEY()=K_ESC
               BREAK
            ENDIF
            j:=0
            nStr++
            RESTSCREEN(5,0,19,79,cScr)
         ENDIF
      NEXT
      END SEQUENCE
      SetWPrinter(2,18,22,'pPrinter')
      aMain:={;
                {'ReportType','Standard'},;
                {'ReportName',ALLTRIM(GetRepName(IF(VALTYPE(FIELD->Shablon)='N',FIELD->Shablon,VAL(FIELD->Shablon))))},;
                {'BasePath',IF(!EMPTY(m->LBL_WPPATH),m->LBL_WPPATH,LoadPPath())},;
                {'ReportId',IF(VALTYPE(FIELD->Shablon)='N',FIELD->Shablon,VAL(FIELD->Shablon))}}
      IF !EMPTY(m->pPrinter)
         AADD(aMain,{'PrinterName',TRIM(m->pPrinter)})
      ENDIF

      aSIZE(aData, LEN(aData)+LEN(aMain))
      FOR i=1 TO LEN(aMain)
         AINS(aData,i)
         aData[i]:=aMain[i]
      NEXT
      FOR i=1 TO LEN(aDescr)
         AADD(aData,{aDescr[i,1],aIn[i]})
      NEXT
      FOR i=1 TO LEN(aCommon)
         AADD(aData,aCommon[i])
      NEXT
      IF LASTKEY() # K_ESC
         PutWinPrint(aData)
      ENDIF
   ENDIF

END SEQUENCE

qPop()
dbPop()
qPop()
ELSE
   SayError('Не настроен "Генератор отчетов для WINDOWS"')
ENDIF
RestSet(aSet)
RestSetKey(aKey)
WSELECT(nWin)
RETURN NIL

******************
FUNCTION  SayRamka(Zag,nTop,nLeftR,i,aDescr)
******************
LOCAL j,nDl:=MAX(LEN(Zag)+4,41), nKStr:=0, nDlGet
FOR j=i TO MIN(i+10,LEN(aDescr))
   nKStr++
   DO CASE
      CASE aDescr[j,3]='C'.OR. aDescr[j,3]='N'
         nDlGet := MIN(44,aDescr[j,4])
      CASE aDescr[j,3]='L'
         nDlGet := 3
      CASE aDescr[j,3]='D'
         nDlGet := 8
      OTHERWISE
   ENDCASE
   nDl:=MAX(nDl,2+25+1+nDlGet+2)
NEXT
nLeftR:=INT((80-nDl)/2)
ShadowBox(Zag,nTop,nLeftR,nTop+nKStr+3,nLeftR+nDl,COL_SHEADR)
@nTop+nKStr+1,nLeftR SAY '╟'+REPLICATE('─',nDl-1)+'╢' COLOR COL_SHEADR
m->nRowPrn:=nTop+nKStr+2
m->nColPrn:=nLeftR+10
m->nDlPrn:=nDl-11
@m->nRowPrn,nLeftR+2 SAY 'Принтер '+LEFT(m->pPrinter,m->nDlPrn) COLOR COL_SHEADR
@nTop+nKStr+3,nLeftR+nDl-22 SAY 'F10:Выбор принтера' COLOR COL_SHEADR

RETURN .T.

******************
FUNCTION GetRepName(IDR)
******************
LOCAL lOpen:=.F.,cRes:='  ',i
Local OldSelect := Select()
if File(AllTrim(PRN0_BEST_PRINT)+'RepList.dbf')
   IF SELECT('RepList')=0
      NetUse('RepList',PRN0_BEST_PRINT+'RepList')
      lOpen:=.T.
   ENDIF
   RepList->(dbGOTOP())
   DO WHILE  RepList->( !EOF())
   IF RepList->ItemID = IDR.and.RepList->ItemType = 1
      cRes:=RepList->Name
      EXIT
   ENDIF
   RepList->(dbSKIP())
   ENDDO
   IF lOpen
      RepList->(dbCloseArea())
   ENDIF
 else
  SayError('Не найден '+AllTrim(PRN0_BEST_PRINT)+'RepList.dbf')
end
Select(OldSelect)
RETURN cRes

Function GetInn(cField)
RETURN If(AT("/",cField)==0, ALLTRIM(cField), ALLTRIM(SUBSTR(cField,1,AT("/",cField)-1)))

Function GetKpp(cField)
RETURN If(AT("/",cField)==0, "", ALLTRIM(SUBSTR(cField,AT("/",cField)+1)))

******************
FUNCTION StrToArrWr(Str,Dl)
******************
LOCAL aRet:={},cRet,cOst,i
IF EMPTY(Str)
   aRet:={''}
ENDIF
DO WHILE !EMPTY(Str)
   cRet:=SUBSTR(Str,1,Dl)
   cOst:=SUBSTR(Str,Dl+1)
   IF LEN(TRIM(Str))<=Dl
      cRet:=TRIM(Str)
      cOst:=''
   ELSEIF SUBSTR(STR,Dl+1,1)$' ('

   ELSE
      FOR i:=Dl TO 1 STEP -1
         IF SUBSTR(Str,i,1)$' ,.);:?!+*/-'
            cRet:=LEFT(Str,i)
            cOst:=SUBSTR(Str,i+1)
            EXIT
         ENDIF
      NEXT
   ENDIF
   Str:=cOst
   AADD(aRet,cRet)
ENDDO


RETURN aRet
//
FUNCTION appMonth(dDateS, nDef)
   LOCAL dDate, nTmpY, nTmpM, cTmp, nDev, nMoth, nYear
   LOCAL nNewM, nNewY, n:=1
   if nDef<>0 .or. nDef#NIL
     //altd()
     cTmp   := ALLTRIM(STR(ABS(nDef/12)))
     nTmpY  := Val(SUBSTR(cTmp,1,AT(".",cTmp)-1)) //Кол-во приб лет
     nYear  := Year(dDateS) //Исходный год
     if nDef>0
       nTmpM := nDef- nTmpY*12//Количество приб месяцев
     else
       nTmpM := nDef+ nTmpY*12
     endif
     nMoth  := Month(dDateS) // исходный месяц
     nNewM  := nMoth + nTmpM //Искомый месяц

     if nNewM>12
       nDev:=1
       nTmpM:=nNewM-12
     elseif nNewM<1
       nDev:=1
       nTmpM:=nNewM+12
     else
       nDev:=0
       nTmpM:=nNewM
     endif

     if nDef>0
       nTmpY  := nYear+nTmpY+nDev
     else
       nTmpY  := nYear-nTmpY-nDev
     endif
     dDate  := CTOD(PADL(ALLTRIM(Str(Day(dDateS))),2,"0")+'/'+PADL(ALLTRIM(Str(nTmpM)),2,"0")+'/'+RIGHT(ALLTRIM(Str(nTmpY)),2))
     if empty(dDate)
       do while empty(dDate)
         dDate := CTOD(PADL(ALLTRIM(Str(Day(dDateS)-n)),2,"0")+'/'+PADL(ALLTRIM(Str(nTmpM)),2,"0")+'/'+RIGHT(ALLTRIM(Str(nTmpY)),2))
         n++
       enddo
     endif
   else
     dDate  := dDateS
   endif
return dDate
//
Function B4_ExportForm()
LOCAL nSaveHandle
LOCAL aSetKey:=SaveSetKey()
Local cFile := _PATH_REPORT //space(40)
 cFile := GetFileName(cFile)

 If (nSaveHandle := FCreate(cFile)) == -1
    SayError( 'Не могу записать файл!' )
 ELSE
   FWRITE( nSaveHandle ,FIELD->Shablon)
   FClose(nSaveHandle)
   SayAndWait( {'Шаблон экспортирован !'} )
 ENDIF
RestSetKey(aSetKey)
RETURN NIL
//
STATIC FUNCTION GetFileName(cDefName, x, cColor,cHeads)
PLOCAL sWin, sColor
 x:=IF(x==NIL, 4, x)
 sWin:=SaveScreen(x, 0, x+3, MAXCOL())
 cColor:=IF(cColor==NIL, 'n/w,gr+/n', cColor)
 cDefName:=IF(cDefName==NIL, UPPER(DISKNAME()+':'+DIRNAME()+'\'), cDefName)
 cDefName:=STRTRAN(cDefName,'\\','\')
 sColor:=SETCOLOR(cColor)
 ShadowBox(IF(cHeads = NIL,' Записать на диск как ... ',cHeads), x, 10, x+2, 70, cColor)
 cDefName:=PADR(cDefName,45)
 @ x+1,12 SAY 'Имя файла:' GET cDefName PICTURE "@KS128"
 SETCURSOR(1); READ ; SETCURSOR(0)
 If LASTKEY() == K_ESC
   cDefName:=''
 EndIF
 RestScreen(x, 0, x+3, MAXCOL(),sWin)
 SETCOLOR(sColor)
RETURN TRIM(cDefName)
Proc BrowseEvent  (o,k)
      do case
        case ( k == K_DOWN )            ; o:down()
        case ( k == K_UP )              ; o:up()
        case ( k == K_RIGHT )           ; o:right()
        case ( k == K_LEFT )            ; o:left()
        case ( k == K_HOME )            ; o:home()
        case ( k == K_END )             ; o:end()
        case ( k == K_PGUP )            ; o:pageUp()
        case ( k == K_PGDN )            ; o:pageDown()
        case ( k == K_CTRL_LEFT )       ; o:panLeft()
        case ( k == K_CTRL_RIGHT )      ; o:panRight()
        case ( k == K_CTRL_PGUP )       ; o:goTop()
        case ( k == K_CTRL_PGDN )       ; o:goBottom()
        case ( k == K_CTRL_HOME )       ; o:panHome()
        case ( k == K_CTRL_END )        ; o:panEnd()
      end
      if  o:colPos <= o:freeze
          o:colPos := o:freeze + 1
      end
//
Function BrowseKey (sleep)
Local lKey := inkey (if ( sleep == NIL, 0,sleep ))
Local bKeyBlock
    while  (bKeyBlock := setkey (lKey)) != NIL
        eval (bKeyBlock, procname (2), procline (2))
        lKey := inkey (sleep)
    end
Return ( lKey )
//
Function DrawPointer(o)
 o:ColorRect({o:rowPos,1,o:rowPos,o:colCount},{1,1})
 o:ForceStable()
 o:ColorRect({o:rowPos,1,o:rowPos,o:colCount},{2,2})
Return (o)
//
Function DataChangeWrite(cName,mValue,cPath)
Local lOp := .f.
Local nArea:=SELECT()
Begin Sequence
    cPath := if( cPath == NIL,LoadPath(),cPath )
    if Select('REORG') == 0
       if FILE(cPath+"Reorg.dbf").AND.NetUse('REORG',cPath+'REORG')
          lOp := .t.
        else
          Break
       end
    end
    if REORG->(dbSeek(Upper(cName))).and.REORG->(RecLock(,.t.)) //_REC_YES
       elseif REORG->(AddRec(.t.))
              Reorg->Name := cName
    end
    if mValue == NIL
      REORG->VALUE:=""
    elseif Valtype(mValue) == 'D'
      REORG->VALUE:="CTOD('"+dToc(mValue)+"')"
    elseif Valtype(mValue) == 'C'
      REORG->VALUE:=mValue
    elseif Valtype(mValue) == 'L'
      REORG->VALUE:=if(mValue,'True','False')
    elseif Valtype(mValue) == 'N'
      REORG->VALUE:="VAL('"+STR(mValue)+"')"
    endif
    REORG->(dbUnLock())

   if lOP
      REORG->(dbCloseArea())
   end
End Sequence
SELECT(nArea)
Return NIL


//--------------------------// перенесено из bal_kas.prg и закомментировано в Tree.prg (PVP)
  FUNCTION InitListHelp(cMess,lFlag,lBeg,NoPg)
//--------------------------//
// Подсказка в MaxRow() при работе в InitList()
LOCAL n_App := 1, _cMess := ""
IF( ValType(cMess) = "C", , cMess := "" )
IF( ValType(lFlag) = "L", , lFlag := .T. )
IF( Type("nApp") != "N", , n_App := MemVar->nApp )


DO CASE
   CASE n_App==0
     _cMess :='Пустое поле:безразличный фактор'
   CASE n_App==1
     IF NoPg==NIL
        _cMess :='┘:Ввод  PgDn/PgUp:Вп/Наз'
     ELSE
        _cMess :='┘:Ввод'
     ENDIF
   CASE n_App==2
     _cMess :='┘:Ввод PgDn:Доср.ввод'
ENDCASE
IF lBeg != NIL
 cMess := _cMess + cMess
ELSE
 cMess += _cMess
EndIf
IF lFlag
  ScrTitul(MaxRow(),cMess)
  RETURN .T.
EndIf
RETURN cMess

//--------------------------------------------------------------------------//
              Function A_Col(aArray, nCol)
//--------------------------------------------------------------------------//
// возвращает колонку (nCol) массива (aArray) как отдельный массив
LOCAL mas_col := {}
AEVAL(aArray, {|x| AADD(mas_col, x[nCol])})
RETURN mas_col
//
FUNCTION GetCenaCN(lRub)
******************
LOCAL nRes := 0, nSum := 0
lRub:=!EMPTY(lRub)
if GlobalTask != '06'
   if !lRub .and. obligate->CodeVal!=GlobalValuta.and.obligate->CodeVal=mdoc->Codeval
      nRes:=mdoc->SumOut
   else
      if mdoc->vid='2'
         nSum:=mdoc->Summa+if(!mdoc->L_NDS,mdoc->Sum_Nds,0)+if(!mdoc->L_Acz,mdoc->Sum_Acz,0)+if(!mdoc->L_CSH,mdoc->Sum_Csh,0)
      else
         IF mdoc->Vid+mdoc->Type = '15' .AND. obligate->CodeVal#mdoc->Codeval
            IF mdoc->Codeval = GlobalValuta
               nSum:=mdoc->sumOut
            ELSE
               nSum:=mdoc->summa
            ENDIF
         ELSEIF mdoc->Vid+mdoc->Type = '15'.AND. obligate->CodeVal=mdoc->Codeval .AND. obligate->CodeVal=GlobalValuta
               nSum:=mdoc->sumOut
         ELSE
            nSum:=mdoc->sumoutr
         ENDIF
      ENDIF
      IF lRub .OR. obligate->CodeVal=GlobalValuta
         nRes:=nSum
      ELSE
         nRes:=DIV(nSum,GetcursVal(obligate->Codeval,mDoc->Date,GetCenaCN('в осн.валюте'),'с запросом'))
      ENDIF
   endif
elseif GlobalTask == '06' // ОС
       S_Oper->(dbPush(,'Code'))
       if Oc_Run->Type == '1'
          if S_Oper->(dbSeek(Oc_Run->Alg))
             if !Empty(s_oper->Model)
                Oc_Calc->(dbPush(,'Code',,{'UniDoc+Model+Code',Oc_Run->UniDoc+s_oper->Model+'SP'}))
                nSum := Oc_Calc->Summa
                Oc_Calc->(dbPop())
               else
                  Run_coc->(dbPush(,'Unidoc',,{'UniDoc',Oc_Run->UniDoc}))
                  Run_coc->(dbEval({||nSum += Run_coc->Summa }))
                  Run_coc->(dbPop())
             end
             else
                  Run_coc->(dbPush(,'Unidoc',,{'UniDoc',Oc_Run->UniDoc}))
                  Run_coc->(dbEval({||nSum += Run_coc->Summa }))
                  Run_coc->(dbPop())
          end
          elseif Oc_Run->Type == '2'
                 dbPush('Run_Coc','Unidoc',,{'UniDoc',Oc_Run->UniDoc})
                 While !eof()
                     nSum += if(Empty(Run_coc->S_Real),Run_coc->Summa,Run_coc->S_Real)
                     dbSkip()
                 end
                 dbPop()
          elseif Oc_Run->Type == 'A'
                  Run_coc->(dbPush(,'Unidoc',,{'UniDoc',Oc_Run->UniDoc}))
                  Run_coc->(dbEval({||nSum += Run_coc->Summa }))
                  Run_coc->(dbPop())
       end
       s_oper->(dbPop())
   //altd()
   IF lRub .OR. obligate->CodeVal=GlobalValuta
      nRes:=nSum
   ELSE
      nRes:=DIV(nSum,GetcursVal(obligate->Codeval,Oc_Run->dOper,GetCenaCN('в осн.валюте'),'с запросом'))
   ENDIF
end
RETURN nRes


FUNCTION LoadPPath()
******************
LOCAL cPath:=LoadPath()
IF AT(':',cPath) =0 .AND. LEFT(ALLTRIM(cPath),1) # '\'
   cPath:=DISKNAME()+':'+DIRNAME()+'\'+cPath
ELSEIF AT(':',cPath) =0 .AND. LEFT(ALLTRIM(cPath),1) = '\'
   cPath:=DISKNAME()+':'+cPath
ENDIF

RETURN cPath

FUNCTION GetCursVal(cCodeVal,dDate,nSumR)
******************
LOCAL lOpen:=.F., nRes
lWithZapr := !EMPTY(lWithZapr)
dbPush()
IF SELECT('VCURS')=0
   lOpen:=.T.
   dbOpenBases({'VCurs'})
ENDIF
SELECT VCurs
IF cCodeVal=GlobalValuta
   nRes:=1
ELSE
   DBSEEK(UPPER(cCodeVal)+DTOS(dDate),.T.)
   IF UPPER(FIELD->Valuta)!=UPPER(cCodeVal).OR.VCurs->Date>dDate
      SKIP -1
   ENDIF
   IF UPPER(FIELD->Valuta)!=UPPER(cCodeVal)
      SKIP
   ENDIF
   IF UPPER(FIELD->Valuta)=UPPER(cCodeVal)
      nRes:=FIELD->VCurs
   ENDIF
ENDIF
If TYPE('cPereCurs') == "C"
   lWithZapr := .f.
   If m->cPereCurs == "2"
      nRes := m->nCursReg
   ElseIf m->cPereCurs == "1"
      m->nCursReg := nRes
   EndIf
EndIf
IF lOpen
   dbCloseBases({'VCurs'})
ENDIF
dbPop()

RETURN nRes



//----------------------------------------------------------------------------//
                  Function SetSeekPos(aVal,lDouble,nNewLen)
//----------------------------------------------------------------------------//
// lDouble - .T. на нижележащие повторяющиеся имена в начало добавляется "_"
LOCAL cName, cInc
IF(!EMPTY(nNewLen),IF(ValType(nNewLen)=='N',lenSeek:=nNewLen,),)
IF aVal != NIL
  aString := AEVAL(aVal,{|x,y| aVal[y] := PADR(FiName(x),lenSeek) })
ENDIF
IF ValType(lDouble) = "L" .AND. lDouble
 AEVAL(aString,{|x,n| cName := x,cInc := "",AEVAL(aString,{|x,n| IF(x = cName,(cInc += "_",aString[n] := cInc+cName),NIL) },n+1) })
ENDIF
RETURN aString


FUNCTION StrS1(cUchet,cMetod)
LOCAL aUchet:={;
   {'1','По учетным ценам    '},;
   {'2','По фактическим ценам'};
   }
LOCAL aUchet1:={;
   {'1','Учетные'},;
   {'2',''};
   }

LOCAL aMetod:={;
   {'1','ФИФО'},;
   {'2','ЛИФО'},;
   {'3','Ср. '};
    }
DO CASE
   CASE EMPTY(cUchet).OR.cUchet='1'
   RETURN SPACE(LEN(aMetod[1,2]))
   /*********************************
   CASE cUchet='1'
   RETURN aUchet1[VAL(IF(EMPTY(cMetod),'1',cMetod)),2]
   ********************************/
ENDCASE
RETURN aMetod[VAL(IF(EMPTY(cMetod),'1',cMetod)),2]


//----------------------------------------------------------------------------//
                     FUNCTION IsSeekNom(cPrefix,cGrup,cNNum,cPartia,cName,lNoBase)
//----------------------------------------------------------------------------//
// Проверяет наличие ссылок на группу,номенклатуру или партию в
// счетах фактурах
// Возвращает признак нахождения
// и  cName по ссылке, где был найдена номенклатура
// lNoBase - если пусто, открывать базы
LOCAL aBase :=;
{;
{"SSH_OP",LoadPath()+"REAL\SH_OP.DBF"},;
{"SSH_FACT",LoadPath()+"REAL\SH_FACT.DBF"},;
{"SH_OP",LoadPath()+"TOVAR\SH_OP.DBF"},;
{"SH_FACT",LoadPath()+"TOVAR\SH_FACT.DBF"};
 }
LOCAL lSeek := .F.
LOCAL cKey := UPPER(IF(cGrup != NIL,cGrup,"")+IF(cNNum != NIL,cNNum,"")+IF(cPartia != NIL,cPartia,""))
LOCAL cType := ""
lNoBase:=!EMPTY(lNoBase)
IF !lNoBase
   dbOpenBases(aBase,,,,.T.)
ENDIF
IF cPrefix == ""
  cType := IF(GlobalTask $ "03TZSR","1","2")
ELSEIF cPrefix == "S"
  cType := "1"
ELSEIF cPrefix == "Z"
  cType := "2"
ELSEIF cPrefix == "T"
  cType := "3"
ENDIF
IF (lSeek := LgSeek("SSH_OP","TAG_TYPEN","SSH_FACT","TAG_OPER","NNOPER_",{|| !EMPTY(SSH_FACT->Tek_Nomer).AND.!EMPTY(SSH_FACT->Type) },;
                                                 {"TYPE+UPPER(GRUP+NNUM+PARTIA)",cType+cKey,,.F.,{"TAG_TYPEN"}}))
  cName := "реестре счетов-фактур (реализация)"
ENDIF
IF !lSeek .AND. (lSeek := LgSeek("SH_OP","TAG_TYPEN","SH_FACT","TAG_OPER","NNOPER_",{|| !EMPTY(SH_FACT->Tek_Nomer).AND.!EMPTY(SH_FACT->Type) },;
                                                                                                        {"TYPE+UPPER(GRUP+NNUM+PARTIA)",cType+cKey,,.F.,{"TAG_TYPEN"}}))
  cName := "реестре счетов-фактур (закупка)"
ENDIF
IF !lNoBase
   dbCloseBases(aBase)
ENDIF

RETURN lSeek


FUNCTION IsMdocM(cKey)
//------------------------------------------------------------------------//
// Поиск в документах склада
LOCAL aBase := {{GetPrefix()+"MDOCM",GetPrefixPath()+"MDOCM"}}
LOCAL lRet := .F., nRec
dbOpenBases(aBase,,,,.T.)
SELECT iMDOCM
ORDSETFOCUS("MDOCM_S")
lRet := dbSeek(UPPER(cKey)) .OR. MSeek(cSelDocM,"MDOCM_AM",cKey,{|| iMDOCM->SCHET_A })
dbCloseBases(aBase)
RETURN lRet


FUNCTION IsSeekKart(cKey)
//------------------------------------------------------------------------//
// Поиск в картотеке
LOCAL aBase := {{GetPrefix()+"MKART",GetPrefixPath()+"MKART"}}
LOCAL lRet := .F.
dbOpenBases(aBase,,,,.T.)
SELECT iMKART
ORDSETFOCUS("MKART")
lRet := iMKART->(DBSEEK(UPPER(cKey)))
dbCloseBases(aBase)
RETURN lRet



//----------------------------------------------------------------------------//
                     FUNCTION LgSeek(cAlias,cTag,cLgAlias,cLgTag,cKeySv,bFor,aScope)
//----------------------------------------------------------------------------//
// Поиск (bFor) по базе (сAlias) с тэгом (cTag)
// хранящегося в дочерней базе (cLgAlias) с тэгом (cLgTag)
// связываемой с родительской по cKeySv
LOCAL lRet := .F.
Busy(.T.,"Поиск")
dbPush(cLgAlias,cLgTag,"","","")
dbPush(cAlias,cTag,,aScope,{{cLgAlias,cKeySv}})
DBEVAL({|| lRet := .T. },bFor,{|| !lRet })
dbPop()
dbPop()
Busy(.F.)
RETURN lRet


//--------------------------------------------------------------------------//
      FUNCTION GetPrefix(cVal)
//--------------------------------------------------------------------------//
// Возвращает cVal с префиксом
RETURN cStPre+IF(cVal != NIL,cVal,"")





      FUNCTION GetPrefixStru(cName)
//--------------------------------------------------------------------------//
// Возвращает имя блока загружаемых переменных по имени и префиксу
IF cStPre == ""
  RETURN cName
ELSEIF cStPre == "Z"
  RETURN cName
ELSEIF cStPre == "T"
  RETURN "T"+RIGHT(cName,LEN(cName)-1)
ENDIF
RETURN cName


      FUNCTION GetPrefixPath()
//--------------------------------------------------------------------------//
// Возвращает путь по префиксу
IF cStPre == ""
  RETURN ""
ELSEIF cStPre == "Z"
  RETURN LoadPath()+"ZAPAS\"
ELSEIF cStPre == "T"
  RETURN LoadPath()+"TOVAR\"
ENDIF
RETURN LoadPath()+"SCLAD\"






//----------------------------------------------------------------------------//
                     FUNCTION MSeek(cAlias,cTag,cKey,bPreKey)
//----------------------------------------------------------------------------//
// Поиск при неизвестной старшей части ключа [EVAL(bPreKey)]+cKey
// по базе cAlias с тэгом cTag
// Ключ только символьного типа !!
LOCAL bakSelect := SELECT(), lRet := .F., bakTag, nRec

SELECT (cAlias)
bakTag := ORDSETFOCUS(cTag)
dbGoTop()
IF bPreKey = NIL
 lRet := dbSeek(UPPER(cKey))
ELSE
  WHILE !EOF()
    nRec := RECNO()
    IF (lRet := dbSeek(UPPER(EVAL(bPreKey)+cKey)))
      EXIT
    ENDIF
    dbGoTo(nRec)
    dbSeek(UPPER(LEFT(EVAL(bPreKey),LEN(EVAL(bPreKey))-1)+CHR(ASC(IF(RIGHT(EVAL(bPreKey),1)#'Я',RIGHT(EVAL(bPreKey),1),CHR(239)))+1)),.T.)
  END
ENDIF
ORDSETFOCUS(bakTag)
SELECT (bakSelect)

RETURN lRet



 Function AOut(Val, nRow, nCol, cColor, aPict)
//--------------------------------------------------------------------------//
// Выводит массив стpуктуpы {x,y,block или xVar, cColor_var }
// ли {{x,y},block или xVar,cColor_var} пpи этом обязат. aPict
// cColor_var - необяз. по умолчан. cColor
   If(ValType(Val) == "A",;
    AEval(Val,;
           {|x,y| IF(;
                     ValType(x[1]) = "A",;
                     AOut(TRANSFORM((FiArea(x[2]))->(EVAL(IF(FieldPos(FiName(x[2])) = 0,MEMVARBLOCK(FiName(x[2])),FIELDBLOCK(FiName(x[2]))))),aPict[y]),x[1][1], x[1][2], IF(LEN(x) > 2,x[3],cColor)),;
                     AOut(x[3],x[1], x[2],  IF(LEN(x) > 3,x[4],cColor));
                    );
            };
          ),;
    (SetPos(If(nRow == NIL, Row(), nRow),;
            If(nCol == NIL, Col(), nCol)),;
            DispOut(If(ValType(Val) == "B", Eval(Val), Val),cColor)))



 Return(NIL)













