| View previous topic :: View next topic |
| Author |
Message |
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
 Posted: 23 Apr 2007 19:40 Post subject: Функции БЭСТа |
 |
|
Перечень
-------------------------------------------------------------------------------------
Наименование функции |Номер| Краткий комментарий
-------------------------------------------------------------------------------------
_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 |
|
| Back to top |
|
 |
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 23 Apr 2007 19:40 Post subject: |
|
|
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) |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 23 Apr 2007 19:46 Post subject: |
|
|
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) |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 23 Apr 2007 19:48 Post subject: |
|
|
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) |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 28 Apr 2007 01:20 Post subject: |
|
|
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 |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 14 May 2007 19:11 Post subject: |
|
|
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. |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 14 May 2007 19:14 Post subject: |
|
|
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 |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 13 Jul 2007 14:42 Post subject: |
|
|
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 |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 13 Jul 2007 14:46 Post subject: |
|
|
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 |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 18 Jul 2007 13:17 Post subject: |
|
|
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) |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 20 Jul 2007 15:35 Post subject: |
|
|
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" |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 25 Jul 2007 14:32 Post subject: |
|
|
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]) |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 30 Jul 2007 14:35 Post subject: |
|
|
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) |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 13 Aug 2007 11:05 Post subject: |
|
|
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) |
|
|
| Back to top |
|
|
nordk
Joined: 27 Jun 2005
Posts: 1000
Location: Горбунов Константин
Occupation: БЭСТ-Партнер
Interests: СПб
|
| Posted: 13 Aug 2007 15:54 Post subject: |
|
|
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) |
|
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © phpBB Group
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
