Форум

FUNCTION Main()
private kodsclada
aSet:=SAVESET()
aSetKey:=SAVESETKEY()
NETUSE("MKART",LOADPATH()+"\SCLAD\MKART.dbf",,.F.)
NETUSE("MSCLAD",LOADPATH()+"\SCLAD\msclad.dbf",,.F.)
//нам надо только по двум складам - поэтому фильтр
msclad->(dbSetFilter({||(msclad->code='    95').or.(msclad->code='    99')}))
DO WHILE SELECTSCLAD(.T.).AND.ADRES(.T.)
ENDDO
MKART->( DBCLOSEAREA() )
MSCLAD->( DBCLOSEAREA() )
RESTSETKEY(aSetKey)
RESTSET(aSet)
RETURN NIL

FUNCTION SELECTSCLAD()
LOCAL aSet,aSetKey,nTop,nBot,cColHead,aBlockCols,cCurProc,aHeads,nUniMode,bDel,bScrInit,aSortSeek
//задание параметров первой прямоугольной области
msclad->(DBGOTOP())

DISPBOX(2,0,7,79,( CHR( 201 ) + CHR( 205 ) + CHR( 187 ) + CHR( 186 ) + CHR( 188 ) + CHR( 205 ) + CHR( 200 ) + CHR( 186 )+' ' ) ,"W+/B")
//задание параметров второй прямоугольной области
DISPBOX(8,0,23,79,( CHR( 201 ) + CHR( 205 ) + CHR( 187 ) + CHR( 186 ) + CHR( 188 ) + CHR( 205 ) + CHR( 200 ) + CHR( 186 )+' ' ) ,"W+/B")
//01.nTop - верхняя строка 
nTop:=3
//02.nBottom - нижняя строка 
nBot:=6
//03.cColHead -  строка или массив строк - заголовок над полями 
cColHead:={"Код склада     Наименование склада"}
//04.Заголовки колонок реестра
aBlockCols:={ {{||FIELD->code},0},{{||FIELD->SHORTNAME},15} }
//05.cCurProc - сопроцедура для QBrowse() cCurProc:={||0}
cCurProc:={||movecursor1()}
//06._aHeads - Описание полей ввода 
aHeads:={{"код склада...............","code"},;
         {"Наименование склада......","SHORTNAME"}}
//11._nUniMode - режим проверки на уникальность
nUniMode:=2
//12.Запрещение удаления в таблице
bDel:={||.F.}
//13.запрет ввода новой записи и корректировки старой
bScrInit:={||If((nApp=2.OR.nApp=1),0,1)}

SHADOWBOX("ENTER:Выбор склада"+CHR(205)+CHR(205)+CHR(205)+CHR(205)+CHR(205)+CHR(205)+CHR(205)+CHR(205)+CHR(205)+"ESC:Выход",7,23,7,62,"B/G")

MSCLAD->( INITLIST(nTop,nBot,cColHead,aBlockCols,cCurProc,;
aHeads,,,,,;
nUniMode,bDel,bScrInit))

RETURN LASTKEY()!=27


FUNCTION ADRES()
LOCAL aSet,aSetKey,nTop,nBot,cColHead,aBlockCols,cCurproc,aHeads,bDel,aWhen,aPic,nUniMode,bScrInit,aSortSeek,cFindMacro
mkart->(ORDSETFOCUS("mkart_sn"))
scopeexpr:=" "+kodsclada
mkart->(SetScope("UPPER(Status+Sclad)",scopeexpr))
mkart->(DBGOTOP())
//удаление будет запрещено
bDel:={||.F.}
//Описание полей ввода
aHeads:={{"Место1...:","mesto1"},;
         {"Место2...:","mesto2"}}
//11._nUniMode - режим проверки на уникальность
nUniMode:=2
//13.запрет ввода новой записи по F4 - И - запрет корр-ки без номера или без партии или закрытых карточек
bScrInit:={||If(nApp=2.OR.(nApp=1.AND.(EMPTY(MKART->NNUM).OR.EMPTY(MKART->PARTIA).OR.!EMPTY(MKART->STATUS))),0,1)} 

aSortSeek:={;
{"- по группам,н/номерам ТМЦ  ",{"Группа.....","Н/номер....","Партия....."},{"right(grup,4)","nnum","partia"},"UPPER(scopeexpr+' '+aIn[1]+aIn[2]+aIn[3])",,,,"mkart_sn"},;
{"- по местам хранения        ",{"Место1.....","Место2....."},{"mesto1","mesto2"},"UPPER(scopeexpr+aIn[1]+aIn[2])",,,,"mkart_adr"}}

nTop:=9
nBot:=22
cColHead:={"СкладГруппа  Номер    Партия   НАИМЕНОВАНИЕ      Кол   Место1     Место2     С"}
cCurProc:={||movecursor2()}

aBlockCols:={{{||RIGHT(FIELD->sclad,2)},0},{{||FIELD->grup},2},{{||FIELD->nnum},8},{{||FIELD->partia},22},{{||LEFT(FIELD->NAME,20)},28},{{||STR(FIELD->koltek,5)},49},{{||FIELD->mesto1},55},{{||FIELD->mesto2},66},{{||FIELD->status},77}}

//SHADOWBOX("ENTER:Изменить адрес"+CHR(205)+CHR(205)+CHR(205)+"F3:Сортировка"+CHR(205)+CHR(205)+CHR(205)+"F6:Фильтр"+CHR(205)+CHR(205)+CHR(205)+"F7:поиск",23,10,23,60,"B/G")
SHADOWBOX("ENTER:Изменить адрес"+CHR(205)+CHR(205)+CHR(205)+CHR(205)+CHR(205)+CHR(205)+"F6:Фильтр"+CHR(205)+CHR(205)+CHR(205)+"F7:поиск",23,10,23,60,"B/G")

mkart->( INITLIST(nTop,nBot,cColHead,aBlockCols,cCurProc,;
aHeads,,aPic,aWhen,,;
nUniMode,bDel,bScrInit,aSortSeek,,;
,,))
RETURN LASTKEY()!=9

//Функция N1 перемещения из перечня складов по ENTER
FUNCTION movecursor1()
LOCAL m1end
IF LASTKEY()=13
    SETLASTKEY(0)
    m1End:=0
    kodsclada:=msclad->code
ELSE
    m1End:=2
ENDIF
RETURN m1end

//Функция N2 возврат к перечню складов
FUNCTION movecursor2()
LOCAL m2end
IF LASTKEY()=9
    SETLASTKEY(0)
    m2End:=0
ELSE
    m2End:=2
ENDIF
RETURN m2end