Функции БЭСТа
Select messages from
# through # FAQ
[/[Print]\]
Goto page 1, 2  Next  :| |:
-> Программирование в БЭСТ-4

#1: Функции БЭСТа Author: nordkLocation: Горбунов Константин PostPosted: 23 Apr 2007 19:40
    —
Перечень
-------------------------------------------------------------------------------------
Наименование функции |Номер| Краткий комментарий
-------------------------------------------------------------------------------------
_SC()...........................| 11 | Функция зарплаты _SC()
AddShFact()..................| 7 | ФОрмирование счетов-фактур
Amload()......................| 12 | Функция чтения табл. документов
ChangeOper()...............| 9 |Ф-ия пересчета в реестре док.товаров
Comment()...................| 13 |работа с мемо-полем
DbOpenBases().............| 16 | Открытие несколько БД
Dbpush()......................| 17 |Сохранение параметров алиаса
GenPro()......................| 8 | Формирование проводок
Jrn_Reestr()..................| 6 | Определ. док. для реестра изменений
Jrn_write()....................| 5 | Запись в журнал реестра изменений
NControlMem()..............| 3 | Отмена генерации NWDOC()
NetUse().......................| 15 |Открытие БД
NewNumDoc()...............| 4 | Генерация уник.номера документа
NVDOC().......................| 2 | к NWDOC()
NWDOC()......................| 1 | Генерация след. номера док-та
PRICEPERE()................. | 20 | Пересчет цен в заказах
QPRINT().......................| 21 | Печать реестра
QPRINT() БЭСТ-5...........| 22 |Тоже но для БЭСТ-5
QPRINT1() БЭСТ-5.........| 23 |
Saldo()..........................| 14 |Функция языка внешней отчетности
SaveSet()..................... | 18 | Сохранение тек.настроек
SaveSetKey()................ | 19 | Сохранение горячих клавиш
WinReport()...................| 10 | Создание печатных форм


Last edited by nordk on 06 Nov 2007 17:34; edited 21 times in total

#2:  Author: nordkLocation: Горбунов Константин PostPosted: 23 Apr 2007 19:40
    —
1
Code:
 FUNCTION NWDoc(cField,xKey,cPre,cTag,cAlias,lClearScope)
//----------------------------------------------------------------------------//
// Генерирует следущий номер документа
// Работает только с символьными полями
// cField - имя поля
// xKey - текущее значение ключа для идентификации раздела !!!
// [cPre] - префикс для идентификации данного типа генерации в пределах текущего
//        сеанса выполнения АРМ'а
// [cTag] - имя тега
// [cAlias] - алиас для доступа к счетчикам. По умолчанию MEMDAT.
// [lClearScope] - очистка Scope
// ВНИМАНИЕ !! Требует открытой базы с алиасом cAlias с полями :
//             IDENT C 50, VALUE C 50, LEN N 2 0, TYPE C 1
//             проиндексированной по UPPER(IDENT)
// Смотри: NVDOC(), NControlMem()

#DEFINE pLastNum      NumSaveLoad(cIdent)[2]
#DEFINE pNextNum      NumSaveLoad(cIdent)[3]
#DEFINE cRetNumValue  NumSaveLoad(cIdent)[4]

LOCAL xNext
LOCAL cFile
LOCAL cIdent := UPPER(cPre+IF(xKey=NIL,"",xKey))
LOCAL cLast:= pLastNum,cNext:= pNextNum

dbPush()
IF(ValType(cTag) = "C",ORDSETFOCUS(cTag),NIL)
IF(lClearScope != NIL .AND. lClearScope ,SetScope(),NIL)
cPre:=IF(cPre=NIL,"",cPre)
IF(ValType(cAlias) = "C",,cAlias := "MEMDAT")

IF ((cAlias)->(dbSeek(PADR(cIdent,LEN((cAlias)->IDENT)))).AND. (cAlias)->(RecLock())) .OR. (cAlias)->(AddRec())
   (cAlias)->IDENT := cIdent
ENDIF

IF !EMPTY((cAlias)->VALUE)
   IF (cAlias)->TYPE = "C"
     pNextNum := LEFT((cAlias)->VALUE,(cAlias)->LEN)
   ELSEIF (cAlias)->TYPE = "D"
     pNextNum := CTOD((cAlias)->VALUE)
   ENDIF
ELSEIF xKey==NIL .OR. LEN(xKey)==0   //.OR.EMPTY(pNextNum)
   GO BOTTOM
   dbSkip(0)
   pNextNum:=EVAL(FIELDBLOCK(cField))
ELSE
   xNext:=SUBSTR(xKey,1,LEN(xKey)-1)+CHR(ASC(SUBSTR(xKey,-1))+1)
   DBSEEK(xNext,.T.)
   SKIP -1
   IF (!(xKey=LEFT(&(INDEXKEY()),LEN(xKey))))
      pNextNum:=BLANK(EVAL(FIELDBLOCK(cField)),.T.)
   ELSE
      pNextNum:=EVAL(FIELDBLOCK(cField))
   ENDIF
ENDIF
IF pNextNum = NIL //Пpи сбоях в файле
   GO BOTTOM
   dbSkip(0)
   pNextNum:=EVAL(FIELDBLOCK(cField))
ENDIF
pLastNum:=pNextNum
pNextNum:=Next(pNextNum)
IF (cAlias)->(RecLock())
   (cAlias)->TYPE := ValType(pNextNum)
   (cAlias)->VALUE := XTOC(pNextNum)
   (cAlias)->LEN := LEN(XTOC(pNextNum))
   (cAlias)->(dbUnLock())
ENDIF
cRetNumValue:=pNextNum
dbPop()
RETURN ObrabotkaNom(cRetNumValue)

#3:  Author: nordkLocation: Горбунов Константин PostPosted: 23 Apr 2007 19:46
    —
2.
Code:
//----------------------------------------------------------------------------//
FUNCTION NVDoc(nAdd,nGet,cField,xKey,cPre,cTag,lRight,cAlias,bVar,lNoSoob,lClearScope,lValidEdit)
//----------------------------------------------------------------------------//
// nAdd - режим nApp
// nGet - номер в GetList
// xKey - текущее значение ключа для идентификации раздела !!!
// [cPre] - префикс для идентификации данного типа генерации в пределах текущего
//        сеанса выполнения АРМ'а
// [cTag] - имя тега
// [lRight] - если .T. то сдвиг вправо
// [cAlias] - алиас для доступа к счетчикам. По умолчанию MEMDAT.
// [bVar] - блок кода доступа к переменной.  По умолчанию {|x| IF(x != NIL,aIn[SeekPos(cField)] := x,aIn[SeekPos(cField)]) }
//          или из GET-буфера
// [lNoSoob] - выдавать ли сообщение о дублировании
//             может быть блоком кода,
//             если EVAL(lNoSoob) вернет .T., то сообщение не выдается
// ВНИМАНИЕ !! Требует открытой базы с алиасом cAlias с полями :
//             IDENT C 50, VALUE C 50, LEN N 2 0
//             проиндексированной по UPPER(IDENT)
// [lClearScope] - очистка Scope
// [lValidEdit] - проверка всегда как редактирование
// Смотри : NWDOC(), NControlMem()

LOCAL lRet:=.T.
LOCAL nRec := RECNO()
LOCAL lSeek := .F.,x, cKey
LOCAL cIdent := UPPER(cPre+IF(xKey=NIL,"",xKey))
LOCAL cLast:=pLastNum,cNext:=pNextNum,cNext0
LOCAL bEnd := {||;
                DBSEEK(SUBSTR(xKey,1,LEN(xKey)-1)+CHR(ASC(SUBSTR(xKey,-1))+1),.T.),;
                dbSkip(-1),;
                IF((!(xKey=LEFT(&(INDEXKEY()),LEN(xKey)))),;
                    BLANK(EVAL(FIELDBLOCK(cField)),.T.),;
                    EVAL(FIELDBLOCK(cField));
                   );
                }
IF(ValType(cAlias) = "C",,cAlias := "MEMDAT")
IF(ValType(lValidEdit) = "L",,lValidEdit := .F.)
dbPush()
IF(lClearScope != NIL .AND. lClearScope ,SetScope(),NIL)
IF(ValType(bVar) = "B",,bVar := {|x| IF(x != NIL,aIn[IF(VarSeekPos(cField,SetSeekPos()) = 0,nGet,VarSeekPos(cField,SetSeekPos()))] := x,aIn[IF(VarSeekPos(cField,SetSeekPos()) = 0,nGet,VarSeekPos(cField,SetSeekPos()))]) })
IF(ValType(cTag) = "C",ORDSETFOCUS(cTag),NIL)
cPre:=IF(cPre=NIL,"",cPre)

IF !EMPTY(lRight) //Случай для документов (не для аналитики)
 IF nGet != NIL
   ToRight(nGet,.T.)
 ELSE
   EVAL(bVar,ObrabotkaNom(EVAL(bVar)))
 ENDIF
ENDIF

IF nGet != NIL
  m->GetList[nGet]:display()
ENDIF
cKey := IF(xKey==NIL,'',xKey)+UPPER(IF(nGet = NIL .OR. m->GetList[nGet]:buffer=NIL,EVAL(bVar),m->GetList[nGet]:buffer))
DBSEEK(cKey)
DBEVAL({|| lSeek := .T. },{|| (nAdd = 2 .AND. !lValidEdit) .OR. nRec != RECNO() },{|| &(ORDKEY()) = cKey.AND.!lSeek  })
IF (LASTKEY()!=K_UP)
   IF  (nAdd==1 .OR. lValidEdit) .AND. lSeek .OR. (nAdd=2 .AND. !lValidEdit .AND. lSeek)
      IF IF(ValType(lNoSoob) = "B",!EVAL(lNoSoob),EMPTY(lNoSoob))
        SayError('Такой номер уже имеется')
      ENDIF
      lRet:=.F.
   ELSEIF nAdd=2
      cNext0:=pNextNum:=EVAL(bVar) //Случай для дополнения аналитики
      IF (cAlias)->(dbSeek(PADR(cIdent,LEN((cAlias)->IDENT))))
        IF (cAlias)->TYPE = "C"
          pNextNum := LEFT((cAlias)->VALUE,(cAlias)->LEN)
        ELSEIF (cAlias)->TYPE = "D"
          pNextNum := CTOD((cAlias)->VALUE)
        ENDIF
      ENDIF

      IF (cNext0 > pNextNum).OR.(cRetNumValue!=NIL.AND.cRetNumValue!=cNext0) //.AND.cNext0 > EVAL(bEnd) )
         pNextNum:=cNext0
         IF (cAlias)->(EOF() .AND. AddRec()) .OR. (cAlias)->(RecLock())
           (cAlias)->VALUE := XTOC(pNextNum)
           (cAlias)->LEN := LEN(XTOC(pNextNum))
           (cAlias)->IDENT := cIdent
           (cAlias)->TYPE := ValType(pNextNum)
           (cAlias)->(dbUnLock())
         ENDIF
      ENDIF
   ENDIF
ENDIF
dbPop()
RETURN(lRet)

#4:  Author: nordkLocation: Горбунов Константин PostPosted: 23 Apr 2007 19:48
    —
3.
Code:
//----------------------------------------------------------------------------//
FUNCTION NControlMem(xKey,cPre,cAlias,lDel)
//----------------------------------------------------------------------------//
// Отмена сгенерированного значения NWDOC()
// xKey - значение ключа для идентификации раздела  !!!
// [cPre] - префикс для идентификации данного типа генерации в пределах текущего
//        сеанса выполнения АРМ'а
// [cAlias] - алиас для доступа к счетчикам. По умолчанию MEMDAT.
// [lDel] - очистка счетчика
// ВНИМАНИЕ !! Требует открытой базы с алиасом cAlias с полями :
//             IDENT C 50, VALUE C 50, LEN N 2 0
//             проиндексированной по UPPER(IDENT)
// Смотри: NWDOC(), NVDOC()
LOCAL cIdent := UPPER(cPre+IF(xKey=NIL,"",xKey))
LOCAL cNum0:=pNextNum,cFile, lBottom, nRec := RECNO()
xKey:=IF(xKey==NIL,'',xKey)
cPre:=IF(cPre=NIL,"",cPre)
IF(ValType(cAlias) = "C",,cAlias := "MEMDAT")
IF (cAlias)->(dbSeek(PADR(cIdent,LEN((cAlias)->IDENT))))
   IF (cAlias)->TYPE = "C"
     pNextNum := LEFT((cAlias)->VALUE,(cAlias)->LEN)
   ELSEIF (cAlias)->TYPE = "D"
     pNextNum := CTOD((cAlias)->VALUE)
   ENDIF
ENDIF
IF pNextNum=cNum0
   pNextNum:= pLastNum
   IF (cAlias)->(EOF() .AND. AddRec()) .OR. (cAlias)->(RecLock())
     IF EMPTY(lDel) .AND. ValType(XTOC(pNextNum)) = "C"
       (cAlias)->VALUE := XTOC(pNextNum)
       (cAlias)->LEN := LEN(XTOC(pNextNum))
       (cAlias)->IDENT := cIdent
       (cAlias)->TYPE := ValType(pNextNum)
       (cAlias)->(dbUnLock())
     ELSEIF !EMPTY(lDel).OR.(dbPush(),dbGoBottom(),lBottom := (nRec = Recno()),dbPop(),lBottom)
       (cAlias)->VALUE := BLANK((cAlias)->VALUE,.T.)
     ENDIF
   ENDIF
ENDIF
RETURN(NIL)

#5:  Author: nordkLocation: Горбунов Константин PostPosted: 28 Apr 2007 01:20
    —
4
Code:
//----------------------------------------------------------------------------//
  FUNCTION NewNumDoc(cSclad,cVid,cType,cCodeDoc)
//----------------------------------------------------------------------------//
// Генерация уникального номера документа
LOCAL cNumDoc
   MDOC->(dbPush(),SetScope())
   cNumDoc := MDOC->(NWDOC("NUMDOC",UPPER(cSclad+cVid+cType+cCodeDoc),"NOM_DOC","MDOC"))
   // Проверка на уникальность
   IF  !MDOC->(NVDOC(S_LIB_ADD,,"NUMDOC",UPPER(cSclad+cVid+cType+cCodeDoc),"NOM_DOC","MDOC",.T.,,{|x| IF(x != NIL,cNumDoc := x,cNumDoc) },.T.))
     // Сброс счетчика
     NControlMem(UPPER(cSclad+cVid+cType+pCodeDoc1),"NOM_DOC",,.T.)
     // Теперь уж точно уникальный номер
     cNumDoc := MDOC->(NWDOC("NUMDOC",UPPER(cSclad+cVid+cType+cCodeDoc),"NOM_DOC","MDOC"))
   ENDIF
   MDOC->(dbPop())
RETURN cNumDoc

#6:  Author: nordkLocation: Горбунов Константин PostPosted: 14 May 2007 19:11
    —
5.

Code:
FUNCTION Jrn_Write(nAdd)
STATIC sPre:="!"
LOCAL nArea:=SELECT(),cReestr:=Jrn_Reestr(),aRee
LOCAL cUserName:=PADR(IF(EMPTY(_USER_NAME),SUBSTR(IDENT_USER,COUNTLEFT(IDENT_USER,"0")+1),_USER_NAME),25)
LOCAL cPre

IF EMPTY(cReestr).OR.;
   UPPER(sPre)==(cPre:=UPPER(DTOS(Date())+LEFT(Time(),5)+cReestr+cUserName+;
   STR(EVAL(aKeys[cReestr,P_NNOPER]),17,0)+STR(nAdd,1,0)))
   RETURN .T.
ENDIF

NetUse("Jrn_Sys",LoadPath()+"Jrn")
AddRec()
REPLACE Date WITH Date(),Time WITH LEFT(Time(),5),Reestr WITH cReestr,;
UserName WITH cUserName,;
NNOper WITH (nArea)->(EVAL(aKeys[cReestr,P_NNOPER])),Oper WITH STR(nAdd,1,0)
sPre:=DTOS(Date)+TIME+Reestr+UserName+STR(NNOPER,17,0)+Oper
REPLACE UserName WITH Crypt(UserName,PAROL)
//IF nAdd==3//пишем всегда, иначе при уалении теряются концы в предыдущих записях
   aRee:=aKeys[cReestr]
   REPLACE Comment WITH ;
   (nArea)->(;
   EVAL1(aRee[P_JRN])+";"+EVAL1(aRee[P_DOC])+;
   ";"+DTOC(EVAL(aRee[P_DATE]))+";"+;
   EVAL1(aRee[P_AGENTNAME])+";"+;
   STR(EVAL(aRee[P_SUMMA]),14,2);
   )
//ENDIF

UNLOCK
CLOSE
SELECT(nArea)
RETURN .T.

#7:  Author: nordkLocation: Горбунов Константин PostPosted: 14 May 2007 19:14
    —
6.

Code:
FUNCTION Jrn_Reestr()
LOCAL cRet:="",i,cPath:=SUBSTR(UPPER(LoadPath()),3),c
SetKeys()
altd()
IF _JRN_YES
   c:=UPPER(dbinfo(10))
   i:=AT(cPath,c)+LEN(cPath)
   TRY
     cRet:=aReestr[SUBSTR(c,i)]
   CATCH
     cRet:=""
   END
ENDIF
RETURN cRet

#8:  Author: nordkLocation: Горбунов Константин PostPosted: 13 Jul 2007 14:42
    —
7.
Code:
           FUNCTION AddShFact(lRefor,aDataDoc,lJoin,lPokup)
//----------------------------------------------------------------------------//
// Формирование или переформирование счета-факутры
// lRefor != NIL, то запрос на переформирование
// aDataDoc - массив структуры {{уникальный номер строки счета-фактуры,номер записи в MDOCM}...}
//            используется при переформировании после редактирования
//            (сохраняет предыдущее состояние)
// lJoin != NIL, то добавление строк накладной к существующему счету-фактуре
// lPokup = .T., то формирование счета-фактуры по закупкам
//               по умолчанию .F.
// см. EditBookData()
PLOCAL lAdd
PLOCAL lEdit := .F., nOper, nRec
PLOCAL bakPrefix := GetPrefix()
PLOCAL nWin := WSELECT()
PLOCAL nLastKey := LastKey(), nVib := 2
PLOCAL cKey := UPPER(MDOC->Sclad+MDOC->Vid+MDOC->Type+MDOC->CodeDoc+MDOC->NumDoc)
PLOCAL lStatus := MDOC->STATUS_F = "1"
PLOCAL aError
PLOCAL nPro
PLOCAL bakReal := IsRealFact(IF(ValType(lPokup) = "L",!lPokup,.T.))
PLOCAL lReal := IsRealFact()
PLOCAL nOperFact, nRecDoc := MDOC->(RECNO()), nOperDoc := -1
PLOCAL bSetDoc := {|nOperDoc,cStatus| MDOC->(dbGoTo(nRecDoc)),IF(!lReal.AND.MDOC->(RecLock()),IF((MDOC->OPER_FACT # nOperDoc.or.MDOC->STATUS_F # cStatus),(MDOC->STATUS_F := cStatus,MDOC->(dbUnLock()),InputToMDoc('MDOC','MDOCM'),NIL),NIL),NIL) }
PLOCAL aData
PLOCAL aMess := IF(lReal,{" Просмотр "," Переформировать "},{"Просмотр","Переформ. без НП","Переформ. с НП"}), aBak, lNoGenDoc := .F.
PLOCAL bGetStavka := {|| IF(!lReal,(MDOC->(dbGoTo(nRecDoc)),GetStavka(),IF(MDOC->(RecLock()),(iMDOC->L_NDS := ilNdsFact,iMDOC->L_ACZ := ilAczFact,iMDOC->L_CSH := ilCshFact,MDOC->(dbUnLock())),NIL)),NIL) }
PRIVATE nVibSF, nUdS:=0
PRIVATE pDate := MDoc->Date  // victor история НДС
PRIVATE lJoinDoc :=.F.
nOperFact := GetMDocFact(cKey,"MDOC",sSH_OP,"MDOCM",aDataDoc)
nPro := RetSavePro("MDOC")
IF lJoin != NIL .AND. nOperFact > 0
  RETURN 2
ENDIF

IF !lReal
 aStOperFact := {}
ENDIF

If (UPPER(ProcName(3))=="DOC").OR.(UPPER(ProcName(2))=="INPUTDOC")
  PRIVATE lFuckingFactuta:=If(lReal,"REAL","TOVAR")
endif

SetLastKey(0)
WSELECT(0)
SetPrefix("")
dbPush(sSH_FACT,"TAG_OPER","","","")
dbSeek(nOperFact)
lAdd := EOF() .OR. nOperFact <= 0
IF lRefor = NIL .AND. lAdd
  IF lJoin != NIL
    nOperFact := InGetOperFact()
    IF LastKey() != K_ESC .AND. nOperFact > 0
      lJoinDoc :=.T.
      lAdd := .F.
      lEdit := .T.
      dbSeek(nOperFact)
      IF FIELD->Cash = '1'
         m->nVibSF := 2
      ELSE
         m->nVibSF := '1'
      ENDIF
      nRec := RECNO()
      EVAL(bGetStavka)
    ENDIF
//  ELSEIF YesOrNo("Сформировать счет-фактуру?") .AND. LastKey() != K_ESC
  ELSEIF ((!lReal.AND.((m->nVibSF:=NoOrYes("Сформировать счет-фактуру?",,{' без НП ',' с НП ',' Oтказ '}))=1 .OR.m->nVibSF=2)).OR. ;
          (lReal.AND.YesOrNo("Сформировать счет-фактуру?")));
         .AND. LastKey() != K_ESC
    EVAL(bGetStavka)
    lEdit := LastKey() != K_ESC
  ENDIF
ELSEIF !lAdd .AND. LastKey() != K_ESC .OR. (!lAdd .AND. lRefor != NIL)
  nRec := RECNO()
  nUdS :=0
  IF lStatus .OR. lReal
    IF !lReal
      SetGetData(lReal,@aData,cKey,nOperFact,"MDOC","MDOCM",sSH_FACT,sSH_OP,sBOOK)
    ENDIF
    AADD(aMess,IF(!EMPTY(aData),"Изм. дату оприх.","Удалить"))
    IF !lReal .AND. LEN(InDocFact(sSH_FACT->NNOPER,sSH_FACT->TYPE_SV,sSH_FACT->OPER_KRED,.T.,,,.T.))>1
      IF sSH_FACT->Cash = '1'
         ADEL(aMess,2)
          nUdS :=2
      ELSE
         ADEL(aMess,3)
          nUdS :=3
      ENDIF
      ASIZE(aMess,LEN(aMess)-1)
    ENDIF
    nVib := NoOrYes(;
        IF(lRefor = NIL,{;
       "Счет-фактура N "+sSH_FACT->TEK_NOMER+" от "+DTOC(sSH_FACT->TEK_DATA),;
       " уже сформирован ";
        },;
        {;
       "По документу сформирован",;
       "счет-фактура N "+sSH_FACT->TEK_NOMER+" от "+DTOC(sSH_FACT->TEK_DATA);
        });
        ,1,aMess,,,,,)
   ELSE
     nVib := 1
   ENDIF
   IF (nUdS = 3 .AND. nVib >2) .OR.(nUdS=2.AND. nVib>1)
      nVib++
   ENDIF
   IF nVib = 2 .OR. (!lReal .AND. nVib = 3)
     IF nVib = 3
      m->nVibSF := 2
     ELSE
      m->nVibSF := 1
     ENDIF
     MDOC->(dbGoTo(nRecDoc))
     aBak := MDOC->(Scatter())
     GetStavka(,MDOC->L_NDS,MDOC->L_ACZ,.T.,MDOC->L_CSH)
     EVAL(bGetStavka)
     ReforShFact(@lEdit,sSH_FACT,sSH_OP,"MDOCM",sBOOK,cKey,aDataDoc,,,{|| IF(MDOC->(RecLock()),MDOC->(Gather(aBak),dbUnLock()),NIL) })
     nVib := NIL
   ELSEIF nVib = 1
     lEdit := .T.
   ELSEIF nVib = 3+IF(lReal,0,1) .AND. !EMPTY(aData)
     SetGetData(lReal,aData,cKey,nOperFact,"MDOC","MDOCM",sSH_FACT,sSH_OP,sBOOK)
   ELSEIF EMPTY(aData) .AND. nVib = 3+IF(lReal,0,1) .AND. (IsDelSHDatCL(@aError,sSH_FACT,sSH_OP ,.T.)).AND. (IsBookFact(cKey,"MDOCM",sSH_FACT,sSH_OP,sBOOK,@aError,,,nOperFact) .OR. (!EMPTY(aError) .AND. SayError(aError)))
     DelShFact(sSH_FACT->NNOPER,sBOOK,"MDOCM",sSH_FACT,sSH_OP,cKey,"MDOC")
     if MDOC->(RecLock())
       MDOC->OPER_FACT := 0
       MDOC->(dbunlock())
       InputToMDoc('MDOC','MDOCM')
     endif
   ENDIF
ENDIF
dbPop()

IF lEdit
 PRIVATE aPay := {}
 PRIVATE pStatus := DEF_OPEN
 PRIVATE pType := "1"
 OpenShFactBase()
 GlobCurs(InputVCurs(GlobalValuta,CURR_DATA,.F.),GlobalValuta)
 SELECT SH_FACT
 IF !lAdd
   dbGoTo(nRec)
 ENDIF
 Edit_FactSchet(IF(lAdd,S_LIB_ADD,S_LIB_EDIT),.F.,IF(lAdd,"1",SH_FACT->TYPE_ST),IF(nVib = 1.OR.nVib = NIL,NIL,nPro),IF(nVib = 1.OR.nVib = NIL,NIL,IF(GetPrefix() == "S" .OR. GlobalTask $ "03SRTZ"," ","1")),.T.,@nOperDoc)
 CloseShFactBase()
 IF !EMPTY(aStOperFact)
   EVAL(bSetDoc,nOperDoc,"1")
   MDOCM->(AEVAL(aStOperFact,{|x| SH_OP->(dbGoTo(x[1])),dbGoTo(x[2]),IF(SH_OP->NNOPER = MDOCM->OPER_FACT.AND.RecLock(),(MDOCM->KOLNED := SH_OP->KOL-MDOCM->KOLBR-MDOCM->KOL,dbUnLock()),NIL) }))
 ENDIF
ENDIF


SetPrefix(bakPrefix)
IF lRefor != NIL
  SetLastKey(nLastKey)
ELSE
  SetLastKey(K_DOWN)
ENDIF
WSELECT(nWin)
IsRealFact(bakReal)
aStOperFact := NIL
RETURN 2

#9:  Author: nordkLocation: Горбунов Константин PostPosted: 13 Jul 2007 14:46
    —
8.

Code:
FUNCTION GenPro( dDat1, dDat2, nMode, nMode1, lPriS0, lPereMbp, aDoc, lOnly, lAct)
#DEFINE VIDTYPE IF(m->plAct, Status+"$", Vid+Type)
    //nMode=2 - все проводки, 1 - отложенные
    //nMode1=1 - запись в главную книгу, 2 - в буфер MProBuf
    //lPris0   - если присутствует, то обрабатываются только проводки c S0
    //lSpisMbp - перерасчитывать ведомости списания МБП
    //aDoc - массив документов {UPPER(Sclad+Vid+Type+CodeDoc+NumDoc)}
    //lOnly - только новые проводки
    //lAct - Проводки по актам переоценки (только для "розницы", обязательно aDoc)
    LOCAL cSDoc:= IF(EMPTY(lAct), "MDoc", "MPere")
    LOCAL nArea := SELECT()
    LOCAL nSumma, aMat, aPro, aPrePro, i, nSum, nDoc := 1
    LOCAL nWin      := WSELECT()
    LOCAL nWin1     := NoOrYes( {'','Генерация проводок   [ ]',''},,,15,35,COL_REFER )
    LOCAL lYes      := INDIK_NEW(18,61)
    LOCAL aBase     := {'MAIN','VALUTA','SPR_PART','S45','S45M','KALK','KALK_S',;
                        {"SSH_FACT",LoadPath()+"REAL\SH_FACT.DBF"},{"SSH_OP",LoadPath()+"REAL\SH_OP.DBF"},{"SH_FACT",LoadPath()+"TOVAR\SH_FACT.DBF"},{"SH_OP",LoadPath()+"TOVAR\SH_OP.DBF"},"SPR_NDS";
                        }

    LOCAL cVid:=m->pVid,cType:=m->pType,cSclad:=m->pSclad


    LOCAL nRec1:=MCodOp->(RECNO())


    PRIVATE pSclad:=cSclad,pType:=cType,pVid:=cVid,pCodeDoc,pNumDoc
    PRIVATE pAgentCode,pDate,DEF_TSUM,TZR1,TZR2,TZR3,pCodeVal,pCenaVal,pPrim,CURS,FLAG := .T.
    PRIVATE SP,SPV,SPP,SPPV,S,SV,S0,Q0,NI,NDS,CSH,SFN,PA,TP,TN,EU,TZR1M,TZR2M,TZR3M,TZR1MN,TZR2MN,TZR3MN,DOP1,DOP2,DOP3,PP1,PP2,R,MEM_MODEL,DEF_PCENA0,SNal
    PRIVATE SPV0,S_NEW,S_OLD,C_NEW,C_OLD, OCN1,OCN2,OCN3,OCN4,OCV1,OCV2,OCV3,OCV4,CenSpCon
    PRIVATE _SUM_OUT_DOC
    PRIVATE pVidType  := IF( GlobalTask == '03', '23', '26' )
    PRIVATE pVidType1 := IF( GlobalTask == '03', '52', '53' )
    PRIVATE plAct
    PRIVATE pOrder   // заказы закупок victor
   PRIVATE nIzn_All, nIzn_AllN, pA_Grup, dPereoc_D, cSchetZM, cSchetZMN, cZCodeM, cZCodeMN,lLinMet:=.F.,lLinMetN:=.F.    // victor спецодежда

    plAct:= IF(lAct==NIL, lAct:= .F., lAct)

   IF VALTYPE(aDoc)=="C"
       aDoc:={aDoc}
   ENDIF
   IF VALTYPE(aDoc)=="A"
      FOR i:=1 TO LEN(aDoc)
      aDoc[i]:=UPPER(aDoc[i])
      NEXT
   ENDIF


    BEGIN SEQUENCE

       (cSDoc)->(DbPush())
       MDocM->(DbPush())
       (cSDoc)->( ORDSETFOCUS( IF( aDoc == NIL, 'MDoc_Dat', IF(EMPTY(lAct),'MDoc', 'TAG_NOM') ) ) )
       MDocM->( ORDSETFOCUS( 'MDocM') )

       dbOpenBases(aBase,,,,.T.)

       KALK->(ORDSETFOCUS("TAG_OPER"))
       KALK_S->(ORDSETFOCUS("TAG_NNOPER"))
       SH_OP->(ORDSETFOCUS("TAG_OPER"))
       SPR_PART->( ORDSETFOCUS("TAG_NUM") )
       MAIN->( ORDSETFOCUS('Tag_NNOper') )
       VALUTA->( ORDSETFOCUS('CODE') )

       SH_OP->(ORDSETFOCUS("TAG_OPER"))
       SPR_NDS->(ORDSETFOCUS("TAG_OPER"))
       SH_FACT->(ORDSETFOCUS("TAG_OPER"))
       SSH_OP->(ORDSETFOCUS("TAG_OPER"))
       SSH_FACT->(ORDSETFOCUS("TAG_OPER"))

       SELECT MDocM
       SET RELATION TO;
                      UPPER(Grup+NNum) INTO MLabel,;
                      UPPER(Grup) INTO MGrup,;
                      UPPER(CodeVal) INTO Valuta,;
                      UPPER(Schet) INTO MSchet,;
                      UPPER(Sclad+Grup) INTO MStru,;
                      UPPER(Grup+NNum+Partia) INTO SPR_PART
       SELECT (cSDoc)
       IF nMode1 = 1
          SET RELATION TO UPPER( VIDTYPE + CodeOper ) INTO MCodOp,;
                          Pro                         INTO Main,;
                          UPPER( VIDTYPE )            INTO Moves
       ELSE
          SET RELATION TO UPPER( VIDTYPE + CodeOper ) INTO MCodOp,;
                          UPPER( VIDTYPE )            INTO Moves
       ENDIF
       IF aDoc == NIL
          DbSeek( DTos( dDat1 ), .T. )
       ENDIF

       // Суммы для накопления в заголовке документа
       IF IS_MODEL
         InitSumModel(@aSumModel)
       ENDIF

       WHILE ( aDoc == NIL .AND. Date <= dDat2 .AND. !EOF() ).OR.;
             ( aDoc != NIL .AND. nDoc <= LEN( aDoc ) )

          IF aDoc!=NIL
             DbSeek( IF(lAct, SUBSTR(aDoc[ nDoc++ ],-6,6), aDoc[ nDoc++ ]) )
             IF lAct.AND.(cSDoc)->PRO<1
                (cSDoc)->(RecLock())
                (cSDoc)->PRO:= Main->(StepPlus())
                (cSDoc)->(DbUnLock())
             ENDIF
          ENDIF
          INDIK_UPDATE(lYes)
          IF !( !lAct .AND. Type == '9' .AND. EMPTY( Date1 ) ) .AND. (;
             ( nMode = 2 .OR. ( nMode = 1 .AND. MCodOp->Status = 1 ) .OR.;
             ( lPriS0 != NIL .AND. ( (IF(lAct,(cSDoc)->Status,Vid ) = '2') .OR.;
              !Moves->YesSeb .OR. (Vid+Type)=="1#" ) ) ) )

             pDate      := Date
             pVid       := IF(lAct, (cSDoc)->Status, Vid)
             pSclad     := IF(lAct, SUBSTR(aDoc[nDoc-1],1,6), Sclad)
             pType      := IF(lAct, "$", Type)
             pModel     := IF(lAct,pModel,Model)
             pCodeDoc   := IF(lAct, SPACE(3), CodeDoc)
             pNumDoc    := IF(lAct, SUBSTR(aDoc[nDoc-1],-6,6), NumDoc)
             pAgentCode := IF(lAct, SPACE(6), AgentCode)
             pAgentCod1 := IF(lAct, SPACE(6), AgentCod1)
             pCodeVal   := IF(lAct, GLOBALVALUTA, CodeVal)
             pCenaVal   := IF(lAct, 1, CenaVal)
             pPrim      := IF(lAct, PADR(FIELD->Name,37), PRIM)
             pOrder      := IF(lAct, SPACE(6), Field->Order)   // заказы закупок victor
             aPrePro    := MakePrePro()
             SELECT MDocM
             DBSEEK(MDoc->( Upper( pSclad + pVid + pType + pCodeDoc + pNumDoc ) ) )
             DOC_FLAG
             DOC_TSUM
             aMat := {{}}
             nSum := nSumma := 0
             WHILE ( Upper( IF(lAct,"",Sclad) + Vid + Type + CodeDoc + NumDoc ) ==;
                     Upper( IF(lAct,"",pSclad) + pVid + pType + pCodeDoc + pNumDoc ) .AND. !EOF())
                INDIK_UPDATE(lYes)
                IF MSchet->Uchet=='1'
                    m->S0:=__CENA*MDocM->Kol
                ELSE
                    m->S0:=MDocM->SUM
                ENDIF
                m->ST:=MLabel->Koef
                m->ST1:=MLabel->Koef1
               m->OCN1 := __RLABEL->OCENA1
               m->OCN2 := __RLABEL->OCENA2
               m->OCN3 := __RLABEL->OCENA3
               m->OCN4 := __RLABEL->OCENA4
               m->OCV1 := __RLABEL->VCENA1
               m->OCV2 := __RLABEL->VCENA2
               m->OCV3 := __RLABEL->VCENA3
               m->OCV4 := __RLABEL->VCENA4
               m->CenSpCon := GetCenSpCon()
                m->CURS:= pCENAVAL
                m->Q0:= IF(MDocM->Type=="$",MDocM->Kol0,MDocM->Kol)
                m->Q_BR:= MDocM->KOLBR
                m->Q_NED:= MDocM->KOLNED
                m->SP:=MDocM->SUMOUTR
                m->SNal:=MDocM->SUMN
                m->SPV:=MDocM->SUMOUT
                m->SPP:=SPR_PART->CENA_P
                m->SPPV:=SPR_PART->CENA_P_V
                m->SPV0:=SPR_PART->CENA_F_V
                IF MDocM->Type=="$"
                   m->S_NEW:= MDocM->Cena0+IF(MDocM->Vid=='1',1,-1)*(MDocM->Sum/Q0)*Q0
                   m->S_OLD:= MDocM->Cena0*Q0
                   m->C_NEW:= MDocM->Cena0+IF(MDocM->Vid=='1',1,-1)*(MDocM->Sum/Q0)
                   m->C_OLD:= MDocM->Cena0
                ENDIF
                m->S:=MDocM->SUMFACT
                m->SV:=MDocM->SUMOUT
                m->NI:=MDocM->IZNOS
                m->NDS:=MDocM->NDS
                m->CSH:=MDocM->CSH
                m->SFN:=MDocM->SFN
                DOC_MODEL
                DEF_DOC_CENA0
                m->PA:=MDocM->PA
                m->TP:=MDocM->TP
                m->TN:=MDocM->TN
                m->EU:=MDocM->EU
                m->DOP1:=MDocM->DOP1
                m->DOP2:=MDocM->DOP2
                m->DOP3:=MDocM->DOP3
                m->TZR1M:=m->TZR1:=MDocM->TZR1M
                m->TZR2M:=m->TZR2:=MDocM->TZR2M
                m->TZR3M:=m->TZR3:=MDocM->TZR3M
                m->TZR1MN:=MDocM->TZR1MN
                m->TZR2MN:=MDocM->TZR2MN
                m->TZR3MN:=MDocM->TZR3MN
                m->PP1:=MDocM->PP1
                m->PP2:=MDocM->PP2
               m->pA_Grup:=MDocM->A_Grup    // victor спецодежда  10
               m->nIzn_All:=MDocM->Izn_All
               m->nIzn_AllN:=MDocM->Izn_AllN
               m->dPereoc_D:=MDocM->Pereoc_D
               IF GlobalTask $ '09ZR'
                  m->cSchetZM:=MDocM->SchetZM
                  m->cSchetZMN:=MDocM->SchetZMN
                  m->cZCodeM:=MDocM->ZCodeM
                  m->cZCodeMN:=MDocM->ZCodeMN
                  m->lLinMet:=LinMetod(MDocM->PERIOD,,,MDocm->Date)
                  m->lLinMetN:=LinMetod(MDocM->PERIOD,'nal',MDocM->Cena0N,MDocm->Date)
               ENDIF
                m->R:=MDocM->R
                IF(LEN(aMat[LEN(aMat)])>999,AADD(aMat,{}),) // (aMat{{}})
                AADD(aMat[LEN(aMat)],;
                     MakeMat(IF(MDocM->Type=="$",Kol0,KolOut),Ed1,IF(MDocM->Type=="$",Kol0,Kol),CenaOut,Ed2,;
                             SumOut,SumOutR,SumFact,Sum,Iznos,;
                             Period,MLabel->Ed,Schet,Kol1,CodeDoc1,;
                             NumDoc1,Sclad1,Kol2,KolBr,KolNed,;
                             Oper_Fact,0,,,Date1,;
                             ,MDocM->SumN))
                nSumma+=SumFact
                nSum+=IF(Vid='2'.OR.!Moves->YesSeb,Sum,SumOutR)
                SKIP
                DO WHILE lAct.AND.;
                   (EOF().OR.Upper(Vid+Type+CodeDoc+NumDoc)!=Upper(pVid+pType+pCodeDoc+pNumDoc)).AND.;
                   nDoc<=LEN(aDoc).AND.SUBSTR(aDoc[nDoc],-6,6)==pNumDoc.AND.;
                   (pSclad:= SUBSTR(aDoc[nDoc],1,6), nDoc++, !DbSeek(aDoc[nDoc-1]))
                   // Неоходимо для нагонки в aMat[{}] строк по акту переоценки
                   // по всем складам.
                ENDDO
             ENDDO
             aPro := AddPro({},aMat,lPriS0,aPrePro)
             IF !lAct.AND.lPriS0!=NIL.AND.MDOC->(RecLock())
                IF TYPE("pModel")=="U"
                   PRIVATE pModel
                ENDIF
                pModel:= MDOC->Model  // !!!!!!!!!!!! Не убирать
                SaveSumFact()
                MDOC->(dbUnlock())
             ENDIF
             WritePro1(nMode,nMode1,aPro,(cSDoc)->Pro,lPriS0,,lOnly,lAct)
          ENDIF
          SELECT (cSDoc)
          IF aDoc==NIL
             SKIP
          ENDIF
       ENDDO
       //Списание товаров отгруженных
       MDocM->( ORDSETFOCUS('MDocM_W') )
       SELECT S45M
       SET RELATION TO UPPER(Sclad+pVidType+CodeDoc1+NumDoc1+Grup+NNum+Partia+Schet_A+AgentCode+if(GlobalTask=="09",STR(Field->NumMbp,17,0)+DTOS(Date),"")) INTO MDocM
       SELECT S45 // Здесь возможен и "54"
       IF nMode1 = 1
          SET RELATION TO Pro                           INTO Main,;
                          Upper( if(GlobalTask=="09".AND.!Empty(Vid),"54",pVidType1) + CodeOper ) INTO MCodOp
       ELSE
          SET RELATION TO Upper( if(GlobalTask=="09".AND.!Empty(Vid),"54",pVidType1) + CodeOper ) INTO MCodOp
       ENDIF
     //  IF lPris0 # NIL .AND. GlobalTask == "09"
      //    OrdSetFocus(0)
      //    DbGoTop()
     //  ELSE
          DbSeek( Dtos( dDat1 ), .T. )
     //  ENDIF
       /*IF lPris0 == NIL
          DbSeek( Dtos( dDat1 ), .T. )
       ELSE
          if( GlobalTask == "09", OrdSetFocus(0), NIL )
          DbGoTop()
       ENDIF */

    //   WHILE ( lPris0 != NIL .OR. ( lPris0 == NIL .AND. Date <= dDat2 ) ) .AND. !EOF()
       WHILE ( /*(lPris0 != NIL.AND. GlobalTask == "09") .OR.*/ ( Date <= dDat2 ) ) .AND. !EOF()
          INDIK_UPDATE(lYes)
          pDate    := Date
          pVid     := LEFT( pVidType1, 1 )
          pType    := RIGHT( pVidType1, 1 )
          pSclad   := SPACE(6)
          pCodeDoc := SPACE(3)
          pNumDoc  := NumDoc
          m->SNal  := 0
          SELECT S45M
          pCodeVal := CodeVal
          pCenaVal := CenaVal
          if GlobalTask == "09"
             SetScope( 'UPPER(Vid+NumDoc)', UPPER( S45->(Vid+NumDoc) ) )
          else
             SetScope( 'UPPER(NumDoc)', UPPER( S45->NumDoc ) )
          endif
          aPro     := AddInsM( 'Только проводки', lPriS0, lPereMbp, IF( lPris0 != NIL, 2, nMode ) )
          SELECT S45
          IF nMode = 2 .OR. ( nMode = 1 .AND. MCodOp->Status = 1 )
             WritePro1( nMode, nMode1, aPro, S45->Pro, lPriS0, 'l45', lOnly, lAct)
          ENDIF
          DbSkip()

       ENDDO
       IF GlobalTask $ '09ZR'
          ORDSETFOCUS('S45_D_M')
          DbSeek( Dtos( dDat1 ), .T. )
       WHILE ( /*(lPris0 != NIL.AND. GlobalTask == "09") .OR.*/ ( Date <= dDat2 ) ) .AND. !EOF()
          INDIK_UPDATE(lYes)
          pDate    := Date
          pVid     := LEFT( pVidType1, 1 )
          pType    := RIGHT( pVidType1, 1 )
          pSclad   := SPACE(6)
          pCodeDoc := SPACE(3)
          pNumDoc  := NumDoc
          m->SNal  := 0
          SELECT S45M
          pCodeVal := CodeVal
          pCenaVal := CenaVal
          if GlobalTask == "09"
             SetScope( 'UPPER(Vid+NumDoc)', UPPER( S45->(Vid+NumDoc) ) )
          else
             SetScope( 'UPPER(NumDoc)', UPPER( S45->NumDoc ) )
          endif
          aPro     := AddInsM( 'Только проводки', lPriS0, lPereMbp, IF( lPris0 != NIL, 2, nMode ) )
          SELECT S45
          IF nMode = 2 .OR. ( nMode = 1 .AND. MCodOp->Status = 1 )
             WritePro1( nMode, nMode1, aPro, S45->Pro, lPriS0, 'l45', lOnly, lAct)
          ENDIF
          DbSkip()

       ENDDO
       ENDIF

    END SEQUENCE
    MDocM->(DbPop())
    (cSDoc)->(DbPop())

    dbCloseBases(aBase)

    INDIK_END(lYes)
    WSELECT(nWin1)
    WCLOSE()
    WSELECT(nWin)
    SELECT(nArea)
    COMMIT
    IF lPereMbp != NIL
       GenSumFact( dDat1, dDat2, 'OnlySpisMbp' )
    ENDIF

    MCodOp->(DbGoto(nRec1))



RETURN NIL

#10:  Author: nordkLocation: Горбунов Константин PostPosted: 18 Jul 2007 13:17
    —
9.
Code:
//--------------------------------------------------------------------------//
                   FUNCTION ChangeOper(aOper,aWork)
//--------------------------------------------------------------------------//
LOCAL cLastColor:=SETCOLOR(COL_SHEADR)
LOCAL nRec:=RECNO(),nOper1,nOper2,cText,nMode,nMode1:=1
LOCAL nTop:=12,nLeft:=27,nBottom:=15,nRight:=59
LOCAL aSetKey:=SaveSetKey(),aSet,cCode1,cCode2
LOCAL sScreen:=SaveScreen(),nWin := WSELECT(),nWin1,lYes,i,lErr:=.F.
LOCAL aItem1:={;
'  - увеличить/уменьшить    ',;
'  - взять из прайс-листа   '}
LOCAL aItem:={' - операции движения ТМЦ         '}
LOCAL aBase := {'MDoc','MDocM','MKart','MLabel','MSclad','MCodOpA','MCodOp','MSchet','MStru','DateSebe','People','SPR_PART',"MOVES",'KALK','KALK_S',"SH_OP","MAIN","VALUTA",'MPar','MCalc','MCalc1',{"SSH_FACT",LoadPath()+"REAL\SH_FACT.DBF"},{"SSH_OP",LoadPath()+"REAL\SH_OP.DBF"},{"SH_FACT",LoadPath()+"TOVAR\SH_FACT.DBF"},{"SH_OP",LoadPath()+"TOVAR\SH_OP.DBF"},"SPR_NDS"}
LOCAL lFirstEnt:=.T., lOneDoc:=.F.
LOCAL bFor := ;
{||;
     lSREdit(1).AND.;
        (;
         !(;
           (nMode = 2 .OR. nMode = 3) .AND.;
           (IS_PSHFACT.OR.IS_SHFACT);
           ) .OR.;
          IF(;
             IS_PSHFACT,;
             EMPTY(SH_FACT->(dbSeek(MDOC->OPER_FACT),SH_FACT->TEK_NOMER)).OR.;
             MDOC->STATUS_F = "1",;
             GetMDocFact(MDOC->(UPPER(Sclad+Vid+Type+CodeDoc+NumDoc)),"MDOC","SSH_OP","MDOCM") <= 0;
             );
          ) .AND.;
        !IsSeek45(MDOC->Vid,MDOC->Type,MDOC->Sclad,MDOC->CodeDoc,MDOC->NumDoc) .AND.;
        !IsSeekRet(MDOC->Vid,MDOC->Type,MDOC->Sclad,MDOC->CodeDoc,MDOC->NumDoc,MDOC->Date) .AND.;
        !((!EMPTY(aWork).AND.;
           !lOneDoc .AND.;
           !EMPTY(MDOC->ID_Reg).AND.;
           YesRegistr(MDOC->ID_Reg)).OR.;
          !MayDelReg(mDoc->Id_Reg) ).AND. ;
        !ChangeO(cCode1,cCode2,lYes,nMode,nMode1);
 }

PRIVATE pUpdated:=.T.
BEGIN SEQUENCE
IF EOF()
  BREAK
ENDIF
IF (GlobalTask$"TV".OR.!IsView(MDoc->Date)) .AND. MDoc->Type # '#' .AND. !Moves->YesUchet
   IF pVid='1'
      AADD(aItem,' - цены поставщиков              ')
   ELSE
      AADD(aItem,' - отпускные цены                ')
   ENDIF
   AADD(aItem,   ' - значения параметров (налогов) ')
ENDIF
IF (nMode:=BoxMenu(' Заменить в документах: ',5,10,aItem,,,,COL_SHEADR,COL_SHEADR,'NoClear',,'Wide'))=0
  BREAK
ENDIF
SAYSCREEN('√',5+nMode,12)
DO CASE
   CASE nMode=1
   cText:='Замена операций......[ ]'
   RestScreen(,,,,sScreen)
   IF LEN(aOper)<=1
      SayError({'Для этого режима требуется более одной операции',;
                'в справочнике типовых операций!'})
      BREAK
   ENDIF
   IF LEN(aWork)==0
      IF !YesOrNo({'Режим заменяет коды операций с пересчетом',;
                 'моделей калькуляции и проводок.',;
                 'Для расчета будут использоваться значения параметров,',;
                 'запомненные на момент ввода соответствующих документов.',;
                 'Обработка производится только для текущего документа !'},,' Продолжать? ',' Возврат ')
         BREAK
      ENDIF
      AADD(aWork,{RECNO(),IF(MDOC->Vid=='1',SumOutR,Summa)})
      lOneDoc=.T.
   ELSE
      IF !YesOrNo({'Режим заменяет коды операций с пересчетом',;
                 'моделей калькуляции и проводок по отмеченным документам.',;
                 'Для расчета будут использоваться значения параметров,',;
                 'запомненные на момент ввода соответствующих документов.',;
                 'Документы, зарегистрированные в расчетах, пересчитаны не будут';
                   };
                 ,,' Продолжать? ',' Возврат ')
         BREAK
      ENDIF
   ENDIF
   RestScreen(,,,,sScreen)
   IF (nOper1:=BoxMenu(' Заменяемая операция ',5,10,aOper,,,,COL_SHEADR,COL_SHEADR,'NoClear'))==0
      BREAK
   ENDIF
   cCode1:=SUBSTR(aOper[nOper1],2,4)
   IF (nOper2:=BoxMenu(' Операцию '+cCode1+' заменить на: ',7,13,aOper,,,,COL_SHEADR,COL_SHEADR))==0
      BREAK
   ENDIF
   cCode2:=SUBSTR(aOper[nOper2],2,4)
/*   IF UPPER(cCode1)==UPPER(cCode2)
      SayError('Заменяемая операция должна отличаться!')
      BREAK
   ENDIF   */
   IF pVid+pType = '26'.AND. MCodOp->(DBSEEK(UPPER(pVid+pType+cCode2)),Schet_A) # MCodOp->(DBSEEK(UPPER(pVid+pType+cCode1)),Schet_A)
      SayError('При замене операции счет не должен изменяться!')
      BREAK
   ENDIF

   CASE nMode=2
   cText:='Изменение цен........[ ]'
   IF pVid='2'.AND.YesDop.AND.YesReal.AND.!_ROZNICA
      IF (nMode1:=BoxMenu(' Режим изменения цен: ',9,20,aItem1,,,,COL_SHEADR,COL_SHEADR,'NoClear',,'Wide'))=0
        BREAK
      ENDIF
      SAYSCREEN('√',10,22)
   ENDIF
   IF nMode1=1
      IF IF(IS_PSHFACT.OR.IS_SHFACT.OR._CN_PRESENT ,;
            !YesOrNo( IF (pVid ='1',  {'Цены в документах, созданных на основании',;
                                       'счетов-фактур, изменены не будут !'},;
                                      {'Режим осуществляет изменение цен в документах',;
                                       'не связанных со счетами-фактурами !' }   ),,' Продолжать? ',' Возврат '),.F.)
        BREAK
      ENDIF
      PRIVATE GetList:={},pProcent:=0,pRound:=0,pNakidka:=0,pSkidka:=0
      PRIVATE aKol:={;
      {-3,'до тысяч   '},;
      {-2,'до сотен   '},;
      {-1,'до десятков'},;
      { 0,'до целых   '},;
      { 1,'до десятых '},;
      { 2,'до сотых   '},;
      { 3,'до тысячных'}}
      ShadowBox("",nTop,nLeft,nBottom,nRight,COL_SHEADR,,'Wide')
      @ nTop+1,nLeft+2 SAY 'Изменить цены на:' GET m->pProcent PICT '9999.999 %'
      @ nTop+2,nLeft+2 SAY 'Округлить       :' GET m->pRound PICT 'XXXXXXXXXXX'
      GetList[2]:block:={|x|RotateBlock(x,m->aKol,'pRound')}
      GetList[2]:reader:={|x|RotateAndReader(x,m->aKol)}
      GetList[2]:display()
      SETCURSOR(1)
      READ
      SETCURSOR(0)
      RestScreen(,,,,sScreen)
      IF LastKey() = K_ESC
        BREAK
      ENDIF
   ENDIF
   IF LEN(aWork)==0
      IF !YesOrNo({'Режим изменяет '+IF(pVid='1','цены поставщиков ','отпускные цены ')+'с пересчетом ',;
                 'моделей калькуляции и проводок по всем документам '+IF(!(IS_PSHFACT.OR.IS_SHFACT),' !',','),;
                 IF((IS_PSHFACT.OR.IS_SHFACT), IF (pVid='1', 'кроме документов, созданных на основании счетов-фактур !', 'не связанным со счетами-фактурами ! ' ),'──────────────────────'),;
                 'Обработка производится только для текущего документа !'},,' Продолжать? ',' Возврат ')
        BREAK
      ENDIF
      AADD(aWork,{RECNO(),IF(MDOC->Vid=='1',SumOutR,Summa)})
      lOneDoc=.T.
   ELSE
      IF !YesOrNo({'Режим изменяет '+IF(pVid='1','цены поставщиков ','отпускные цены ')+'с пересчетом ',;
                 'моделей калькуляции и проводок по отмеченным документам,',;
                 IF((IS_PSHFACT.OR.IS_SHFACT),;
                    IF (pVid = '1' ,;
                        'кроме документов, созданных на основании счетов-фактур !' ,;
                        'не связянных со счетами-фактурами ! ' ) ,;
                    '──────────────────────'),;
                   'Документы, зарегистрированные в расчетах, пересчитаны не будут';
                 },,;
                 ' Продолжать? ',' Возврат ')
        BREAK
      ENDIF
   ENDIF

   CASE nMode=3
   cText:='Изменение параметров [ ]'
   RestScreen(,,,,sScreen)
   IF LEN(aWork)==0
      IF !YesOrNo({'Режим осуществляет подстановку значений параметров',;
                   'из справочника групп, используемых в калькуляциях и проводках,',;
                   'если значения параметров были изменены после ввода документа.' ,;
                   'Также производится пересчет калькуляций и проводок.'  ,;
                   IF((IS_PSHFACT.OR.IS_SHFACT),   'Подстановка не осуществляется для документов,','──────────────────────'),;
                   IF((IS_PSHFACT.OR.IS_SHFACT),  IF (pVid = '1' , 'созданных на основании счетов-фактур ! ', 'связанных со счетами-фактурами') ,''),;
                   'Обработка производится только для текущего документа !'},,' Продолжать? ',' Возврат ')
        BREAK
      ENDIF
      AADD(aWork,{RECNO(),IF(MDOC->Vid=='1',SumOutR,Summa)})
      lOneDoc=.T.
   ELSE

      IF !YesOrNo({'Режим осуществляет подстановку значений параметров',;
                   'из справочника групп, используемых в калькуляциях и проводках,',;
                   'если значения параметров были изменены после ввода документа.' ,;
                   'Также производится пересчет калькуляций и проводок.'  ,;
                   IF((IS_PSHFACT.OR.IS_SHFACT),   'Подстановка не осуществляется для документов,','──────────────────────'),;
                   IF((IS_PSHFACT.OR.IS_SHFACT),  IF (pVid = '1' , 'созданных на основании счетов-фактур ! ', 'связанных со счетами-фактурами') ,''),;
                   'Документы, зарегистрированные в расчетах, пересчитаны не будут',;
                   'Обработка производится только для отмеченных документов !'},,' Продолжать? ',' Возврат ')

        BREAK
      ENDIF
   ENDIF
ENDCASE
RestScreen(,,,,sScreen)
nWin1:=NoOrYes({'',cText,''},,,15,35,COL_SHEADR)
lYes := INDIK_NEW(18,61)
dbOpenBases(aBase,,,,.T.,.T.)
SH_OP->(ORDSETFOCUS("TAG_OPER"))
SH_FACT->(ORDSETFOCUS("TAG_OPER"))
SSH_OP->(ORDSETFOCUS("TAG_NNOPER"))
SSH_FACT->(ORDSETFOCUS("TAG_KREDIT"))
SELECT MCalc1
SET RELATION TO UPPER(Vid+Ident) INTO MPar
Main->(ORDSETFOCUS('Tag_NNOper'))
SELECT MDoc
IF LEN(aWork) > 0
  FOR i:=1 TO LEN(aWork)
   INDIK_UPDATE(lYes)
   GO aWork[i,1]
   IF !IsDateOut(MDoc->DATE,.T.).AND.EVAL(bFor)
     lErr:=.T.
   ENDIF
   IF  lFirstEnt.AND.!A3MaxDate(DateProv(MDoc->Pro))
       lFirstEnt:=.F.
       lErr:=.T.
   ENDIF
  NEXT
ELSE
  GO TOP
  WHILE !EOF()
     INDIK_UPDATE(lYes)
     IF !IsDateOut(MDoc->DATE,.T.).AND.EVAL(bFor)
        lErr:=.T.
     ENDIF
     IF  lFirstEnt.AND.!A3MaxDate(DateProv(MDoc->Pro))
         lFirstEnt:=.F.
         lErr:=.T.
     ENDIF
     SKIP
  ENDDO
ENDIF
INDIK_END(lYes)
WSELECT(nWin1)
WCLOSE()

dbCloseBases(aBase)
aWork:={}
IF nMode=1.AND.lErr
   SayError({'После перерасчета операций',;
             'в документах,помеченных знаком "?"',;
             'имеются ошибки!'})
ENDIF

END SEQUENCE

WSELECT(nWin)
RestScreen(,,,,sScreen)
RestSetKey(aSetKey)
SELECT MDoc
COMMIT
GO nRec
RETURN(2)

#11:  Author: nordkLocation: Горбунов Константин PostPosted: 20 Jul 2007 15:35
    —
10.

Code:
FUNCTION WinReport(cReport,cFile,cFile1,lDesigner)
/**********
cFile - имя файла описания шапки с полями:VarName,VarC,VarN,VarD,VarL,FieldName
или массив {cVarName,xVar, cField/nElement} - наименование, значение, имя поля в cFile1 или в номер значения в строке-массиве
сFile1 - имя файла строк или массив значений
В более сложных случаях может в cFile1 могут быть перечислены несколько файлов
через запятую,например "File1,File2,File3",тогда в первом файле сField указывается
в виде "File.Pield", где File - не обязательно полное имя файла таблицы,
может быть часть, лишь бы бы входила бы как часть имени и отличалась от других
Вместо файлов могут передаваться алиасы открытых областей (тогда, если их
несколько, в cField указывается точное название алиаса и имя поля через точку).
*********************************/


LOCAL nArea:=SELECT()
LOCAL aVar:={},aVar1:={},nField,xVal
LOCAL lTable1:=VALTYPE(cFile1)="C".AND.NetUses(cFile1,aVar1)
LOCAL lArray1:=VALTYPE(cFile1)=="A",aLen:={}
LOCAL lTable:=VALTYPE(cFile)="C".AND.(SELECT(cFile)>0.OR.NetUse("RpTable",cFile,,,,.T.))
LOCAL cVarFile:=TEMPFILE(m->GlobalTmpPath,"xml"),nVarFile
LOCAL cHead:="",cVar:='<Row i_d="1" ',j:=1,i,cSpisok,nSpisok
LOCAL aVar1N

IF !(VALTYPE(cReport)=="C".AND.!EMPTY(cReport))
   SayError("Ошибка в указании 1-го параметра (имени шаблона) WinReport!")
   RETURN "WINREPORT"
ELSEIF EMPTY(cFile)
   SayError("Ошибка в указании 2-го параметра WinReport!")
   RETURN "WINREPORT"
ENDIF

altd()

busy(.T.,"Подготовка данных")

IF lArray1
   //находим макс.длины полей, если задан массив строк
   ASIZE(aLen,LEN(cFile1[1]))
   AFILL(aLen,0)
   FOR i:=1 TO LEN(cFile1)
   FOR j=1 TO LEN(cFile1[i])
   IF VALTYPE(cFile1[i,j])=="C"
      aLen[j]:=MAX(aLen[j],LEN(cFile1[i,j]))
   ENDIF
   NEXT
   NEXT
   aVar1:={{"","",{}}}
ENDIF



IF lTable
   IF SELECT(cFile)>0
      DbSelectArea(cFile)
   ELSE
      SELECT RpTable
   ENDIF
   cAlias:=ALIAS()
   DbGoTop()
   WHILE !EOF()
      IF !(DELETED().OR.EMPTY(FIELD->VarName))


         IF EMPTY(FIELD->FieldName)
            xVal:=GetMyVar()
            AADD(aVar,{MyName(FIELD->VarName),VALTYPE(xVal),LenVar(xVal),xVal})
         ELSEIF lTable1

            AddVar1(aVar1,cFile1,MyName((cAlias)->VarName),(cAlias)->FieldName)
         ENDIF
      ENDIF
      SKIP
   ENDDO
ELSEIF VALTYPE(cFile)=="A"
   FOR i:=1 TO LEN(cFile)
   IF LEN(cFile[i])<3.OR.EMPTY(cFile[i,3])
      xVal:=cFile[i,2]
      AADD(aVar,{MyName(cFile[i,1]),VALTYPE(xVal),LenVar(xVal),xVal})
   ELSEIF lTable1
      AddVar1(aVar1,cFile1,MyName(cFile[i,1]),cFile[i,3])
   ELSEIF lArray1.AND.VALTYPE(cFile[i,3])=="N".AND.(nField:=cFile[i,3])>0
      AADD(aVar1[1,3],{MyName(cFile[i,1]),VALTYPE(cFile1[1,nField]),aLen[nField],nField})
   ENDIF
   NEXT
ENDIF



IF ( nVarFile := FCREATE(cVarFile) ) == -1
   SayError( "Ошибка создания временного файла "+cVarFile)
ELSE
   FWRITE(nVarFile,'<?xml version="1.0" encoding="windows-1251"?>'+CRLF)
   FWRITE(nVarFile,"<DataBase>"+CRLF)

   FWRITE(nVarFile,"<SMakers>"+CRLF)

   FWRITE(nVarFile,'<SMaker name="bda.s_maker">'+CRLF)
   //Шапка
   FWRITE(nVarFile,'<Part PartName="'+DosToXML("Шапка")+'" PartType="1">'+CRLF)
   FOR i:=1 TO LEN(aVar)
   cHead+=FieldToXml(i,aVar[i,1],aVar[i,2],aVar[i,3])
   cVar+=Fi(i)+'="'+ DosToXML(GetVal(aVar[i,4]))+'" '
   NEXT
   FWRITE(nVarFile,"<FieldDefs>"+CRLF)
   FWRITE(nVarFile,cHead)
   FWRITE(nVarFile,"</FieldDefs>"+CRLF)
   FWRITE(nVarFile,"<Rows>"+CRLF)
   cVar+="/>"+CRLF
   FWRITE(nVarFile,cVar)
   FWRITE(nVarFile,"</Rows>"+CRLF)
   FWRITE(nVarFile,'</Part>'+CRLF)

   IF lTable1.OR.lArray1
      FOR nSpisok:=1 TO LEN(aVar1)
      //Список
      cHead:=""
      cSpisok:="Список"
      IF LEN(aVar1)>1
         cSpisok+="_"+aVar1[nSpisok,4]
      ENDIF
      FWRITE(nVarFile,'<Part PartName="'+DosToXML(cSpisok)+'" PartType="1">'+CRLF)
      aVar1N:=aVar1[nSpisok,3]

      FOR i:=1 TO LEN(aVar1N)
      cHead+=FieldToXml(aVar1N[i,4],aVar1N[i,1],aVar1N[i,2],aVar1N[i,3])
      NEXT
      FWRITE(nVarFile,"<FieldDefs>"+CRLF)
      FWRITE(nVarFile,cHead)
      FWRITE(nVarFile,"</FieldDefs>"+CRLF)
      FWRITE(nVarFile,"<Rows>"+CRLF)
      j:=1
      IF lTable1
         DbSelectArea(aVar1[nSpisok,2])
         dbGoTop()
         WHILE !EOF()
            cVar:='<Row i_d="' + LTRIM(STR(j++,10,0))+'" '
            FOR i:=1 TO LEN(aVar1N)
            IF (nField:=aVar1N[i,4])>0
               cVar+=FI(nField)+'="'+ DosToXML(GetVal(FIELDGET(nField)))+'" '
            ENDIF
            NEXT
            cVar+="/>"+CRLF
            FWRITE(nVarFile,cVar)
            SKIP
         ENDDO
      ELSE
         FOR j:=1 TO LEN(cFile1)
         cVar:='<Row i_d="' + LTRIM(STR(j,10,0))+'" '
         FOR i:=1 TO LEN(aVar1N)
            IF (nField:=aVar1N[i,4])>0
               cVar+=FI(nField)+'="'+ DosToXML(GetVal(cFile1[j,nField]))+'" '
            ENDIF
            NEXT
            cVar+="/>"+CRLF
            FWRITE(nVarFile,cVar)
         NEXT
      ENDIF
      FWRITE(nVarFile,"</Rows>"+CRLF)
      FWRITE(nVarFile,'</Part>'+CRLF)
      NEXT //nSpisok
   ENDIF

   FWRITE(nVarFile,"</SMaker>"+CRLF)
   FCLOSE(nVarFile)
   AppendDopFile(cVarFile)

ENDIF


busy(.F.)
IF lTable.AND.SELECT("RpTable")>0
   RpTable->(DbCloseArea())
ENDIF
IF lTable1
   NetCloses(aVar1)
ENDIF

FRCall("ShowReport",LoadPath()+cReport,cVarFile,IF(lDesigner!=NIL.AND.lDesigner,1,0),1)
WHILE .T.
   INKEY(.1)
   IF !FILE(cVarFile)
      Exit
   ENDIF
ENDDO
SELECT(nArea)

RETURN "WINREPORT"

#12:  Author: nordkLocation: Горбунов Константин PostPosted: 25 Jul 2007 14:32
    —
11.

Code:
 Function _SC(nCo)

   MemVar aLines

   If Y_Type(MemVarBlock("NFLAG"), "B")

    Return(If(nCo > 0 .And. nCo < Val(FiGet(NCOL)),;
            1,;
            (;
               SayError({"Выражение в формуле: _SC(" + LTrim(Str(nCo)) +;
                         ")  - должно ссылаться на номер",;
                         "колонки, которая расcчитыва" +;
                         "ется раньше текущей колонки!"}, 15),;
               NIL;
            )))

   EndIf

 Return (aLines[nCo, 1])

#13:  Author: nordkLocation: Горбунов Константин PostPosted: 30 Jul 2007 14:35
    —
12.

Code:
 Function AMLoad(cMemoField)

   MemVar nQCol, aEmpty

   Local cStr := FsGet(cMemoField)
   Local nLen := Len(cStr) / 16
   Local aRet

   If(nLen == nQCol,;
    (;
       aRet := Array(nLen, 2),;
       AEval(aRet,;
             {;
                |x, i, p|;
                p := (i - 1) * 16 + 1,;
                aRet[i, 1] := Val(SubStr(cStr, p, 15)),;
                aRet[i, 2] := Val(SubStr(cStr, p + 15, 1));
             });
    ),;
    aRet := AClone(aEmpty))

 Return (aRet)

#14:  Author: nordkLocation: Горбунов Константин PostPosted: 13 Aug 2007 11:05
    —
13.
Code:
FUNCTION Comment(lWrite,lView)
LOCAL nWin:=WSELECT()
LOCAL aSetKey:=SaveSetKey(),cLastColor
LOCAL nTop:=8,nLeft:=13,nBottom:=15,nRight:=70
LOCAL sRest,sRest24,cSclads:=pSclads, oldCursor
WSELECT(0)
sRest:=SAVESCREEN(nTop,nLeft,nBottom,nRight)
sRest24:=SAVESCREEN(23,0,24,79)
cLastColor:=SETCOLOR(COL_SHEADR)
@ nTop,nLeft TO nBottom,nRight DOUBLE COLOR COL_SHEADR
@ nTop,nLeft+20 SAY ' Комментарий '
IF !_REC_YES
   lView:=.T.
ENDIF
IF lView==NIL
   ScrTitul(24,"Ctrl┘:Конец ввода ┘:Новая строка Ctrl-Y:Удалить строку Ins:Режим вставки")
   ScrTitul(23,"")
   SETKEY(K_CTRL_RET,{||Keyb(K_CTRL_W)})
ENDIF
oldCursor=IF(lView==NIL,SETCURSOR(1),SETCURSOR(0))
pSclads:=MEMOEDIT(pSclads,nTop+1,nLeft+1,nBottom-1,nRight-1,(lView==NIL),'FunBook',100)
IF lView==NIL.AND.!pSclads==cSclads
   pUpDated:=.T.
   IF lWrite!=NIL
      RecLock()
      REPLACE Sclads WITH pSclads
      UNLOCK
      COMMIT
   ENDIF
ENDIF
SETCURSOR(oldCursor)
RestSetKey(aSetKey)
SETCOLOR(cLastColor)
RESTSCREEN(nTop,nLeft,nBottom,nRight,sRest)
RESTSCREEN(23,0,24,79,sRest24)
WSELECT(nWin)
RETURN(NIL)

#15:  Author: nordkLocation: Горбунов Константин PostPosted: 13 Aug 2007 15:54
    —
14

Code:
FUNCTION Saldo( cVO, aPar )  // сальдо счета
  LOCAL nRez := 0, cSchet, i, cCode, cNS, cKey := '', cAlias,;
        aOst:= {0,0}
  FIELD DTOB_n,KTOB_n,DTOST,KTOST

  cNS := UPPER(aPar[1])
  IF ( i:=AT(".", cNS) ) == 0
    cAlias := 'TMP'
    IF ( i := AT("*", cNS) ) == 0                  //Сюда
       cSchet := PADR( ALLTRIM( cNS ) , 10 )
       i := 10
    ELSEIF i == 3
       i := 2
       cSchet := LEFT( cNs, i )
       cAlias := "TMPSCHET"
    ELSE
      i--
      cSchet := LEFT( cNs, i )
    ENDIF
    cKey := aVariables[1][2]+cSchet
    //(cAlias)->( SetScope( '', cKey,, {OrdSetFocus()} ),;
    (cAlias)->( SetScope( OrdKey(), cKey ),;
                /*BROWSE(),*/;
                dbEval( {||IF(RIGHT(cVo,1) == "0" , aOst[1] += DTOB_n, ),;
                           IF(RIGHT(cVo,1)==  "1" , aOst[1] += DTOST,  ),;
                           IF(RIGHT(cVo,1) == "0" , aOst[2] += KTOB_n, ),;
                           IF(RIGHT(cVo,1) == "1" , aOst[2] += KTOST,  ) ;
                         } ),;
                SETSCOPE();
              )
     nRez := OstSchet(aOst, cSchet, '', aVariables[1][2], {        ;
               {0,.T.},;
               {0,.T.} ;
              })[IF(LEFT(cVo,1)=='0',1,2)][1]
  ELSE
    cSchet := PADR( ALLTRIM( LEFT(cNS, i-1)  ), 10 )
    cCode  := SUBSTR(cNS, i+1)
    IF ( i := AT("*", cSchet) ) <> 0
       cSchet := LEFT( cSchet, --i)
    ENDIF
    cKey := aVariables[1][2]+cSchet
    IF ( i := AT("*", cCode) ) == 0
      i := 6
      cCode  :=   Global_Analit( cCode )
    ELSE
      i--
      cCode := LEFT( cCode, i )
    ENDIF
    IF LEN(cSchet) == 10 ;   cKey += cCode ;    ENDIF

    TMPANAL->( SetScope( '', cKey,, { OrdSetFocus() } ),;
               dbEval( {||IF(cVo == "00" , nRez += TMPANAL->DTOB_n, ),;
                          IF(cVo == "01" , nRez += TMPANAL->DTOST,  ),;
                          IF(cVo == "10" , nRez += TMPANAL->KTOB_n, ),;
                          IF(cVo == "11" , nRez += TMPANAL->KTOST,  ) ;
                       },;
                       {|| TMPANAL->CODE = cCode };
                     ),;
               SetScope();
            )
  ENDIF

   IF nErrorTmp <> -1 // предупреждения нужны
    IF !VALUTA->(dbSEEK( aVariables[1][2]) )
      Str2File( " Код валюты: "+aVariables[1][2]+" отсутствует в справочнике валют", nErrorTmp )
    ENDIF
      IF !PLAN->(dbSEEK( cSchet ))
      Str2File( "Строка N"+STR(nLine,10)+" Счет: "+cSchet+" отсутствует в плане счетов", nErrorTmp )

      ELSEIF cCode <> NIL     .AND. ;
                !ANALIT->(dbSEEK( cSchet+cCode ))
         Str2File( "Строка N"+STR(nLine,10)+" Аналитический счет: "+cCode+;
                     " на счете: "+cSchet+"отсутствует", nErrorTmp )
      ENDIF
   ENDIf

RETURN (nRez)



-> Программирование в БЭСТ-4


output generated using printer-friendly topic mod. All times are GMT + 4 Hours

Goto page 1, 2  Next  :| |:
Page 1 of 2

Powered by phpBB © 2001, 2005 phpBB Group