 ************
 *
 * Программа..:  Общие функции складского учета,реализации,закупок
 * Имя файла..:  G_Refer.Prg
 * Автор......:  А. Титов
 * Назначение.:  Простейший типовой справочник
 *
 ******
 // Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.
#Include "inkey.ch"
#Include "s_public.ch"
 //Предполагается база с записью Vid,Type,Code,Name (или ShortName)
 //(Vid,Type или Code могут отсутствовать)
 //Если cVid указан, то устанавливается фильтр Vid+Type==cVid+cType
 Static MayBlock,bPost

 Function GRefer(cBase,cVid,cType,cHead,cHead1,bMayBlock,bClose,cFindMacro,NoEdit)
   //cBase имя базы или блок открытия и RELATION
   //bIs-блок проверки на возможность корректировки ключа или удаления
   //bClose-блок закрытия (если задан блок открытия)
   Local cScreen:=SaveScreen(),aSetKey:=SaveSetKey()
   Local cColHead,aBlockCols,nLenCode,nLenName,lName
   Local nTop:=4,nBottom:=20
   Local cCurProc,aHeads,aRef
   Local aPict:={'@K','@K'}
   Local aWhen:={{||WGRefer()}}
   Local aValid:={{||ToRight(1)}}
   Local nUniMode:=2
   Local bDelInit:={||GDel()}
   Local bScrInit,aSortSeek,apHeads,cName
   bPost:=If(cVid!=NIL,;
             {||;
             FieldPut(FieldNum('Vid'),pVid),;
             FieldPut(FieldNum('Type'),pType);
             },NIL)
   MayBlock:=bMayBlock
   Private pVid:=cVid
   Private pType:=cType
   If cHead1!=NIL
     nTop+=2
   EndIf
   cHead1:=If(cHead1==NIL,'',cHead1)
   If ValType(cBase)=='C'
     m_Open_Base({cBase})
   Else
     Eval(cBase)
   EndIf
   lName:=FieldNum('Name')>0
   cName:=If(lName,'Name','ShortName')
   nLenCode:=FieldSize(FieldNum('Code'))
   nLenName:=FieldSize(FieldNum(If(lName,'Name','ShortName')))
   cColHead:=' '+If(nLenCode>0,Space(nLenCode+3),'')+;
               PadR(If(nLenName<12,'Наимен','Наименование'),nLenName+1)
   If (cVid!=NIL)
     SetScope('Vid+Type',pVid+pType)
   Else
     pVid:=pType:=''
   EndIf
   aHeads:={{'Код (номер)..... ','Code'},{'Наименование.... ',cName}}
   aSortSeek:={;
               {'- по кодам         ','Код?:','Code','pVid+pType+UPPER(aIn[1])',;
               '@K','ToRight(1)'},;
               {'- по наименованиям ','Наименование?:','LEFT(Name,10)',;
               'pVid+pType+UPPER(TRIM(aIn[1]))','@K'}}
   If (nLenCode==0)
     aBlockCols:={;
                  {{||If(lName,Field->Name,Field->ShortName)},1}}
     ADel(aHeads,1);ASize(aHeads,1)
     ADel(aSortSeek,1);ASize(aSortSeek,1)
     aPHeads:={cHead,{'Наименование',cName}}
     aWhen:=aValid:=NIL
   Else
     cColHead:=Stuff(cColHead,2,3,'Код')
     aBlockCols:={;
                  {{||Field->Code},1},;
                  {{||If(lName,Field->Name,Field->ShortName)},4+nLenCode}}
     If (Empty(IndexKey(2)))
       ASize(aSortSeek,1)
     EndIf
     aPHeads:={cHead,{'Код','Code'},{'Наименование',cName}}
   EndIf
   If NoEdit!=NIL
     SetKey(K_F8,{||1})
     SetKey(K_F4,{||1})
     SetKey(K_RETURN,{||1})
   EndIf
   Go TOP
   InitScreen(cHead,cHead1,cColHead)
   If NoEdit!=NIL
     ScrTitul(24,"F6,Alt-F6:Фильтр F7,Alt-F7:Поиск F9:Печать")
   ElseIf Empty(IndexKey(2))
     ASize(aSortSeek,1)
     ScrTitul(24,Chr(17)+"┘:Правка F4:Добавить F6,Alt-F6:Фильтр F7,Alt-F7:Поиск F8:Удалить F9:Печать")
   EndIf
   InitList(nTop,nBottom,cColHead,aBlockCols,cCurProc,aHeads,aRef,;
            aPict,aWhen,aValid,nUniMode,bDelInit,bScrInit,aSortSeek,aPHeads,;
            bPost,,,,,,,cFindMacro)
   If (bClose==NIL)
     m_Close_Base({cBase})
   Else
     Eval(bClose)
   EndIf
   RestScreen(,,,,cScreen)
   RestSetKey(aSetKey)
   Return (NIL)

 Function WGRefer()
   Local lRet:=.T.
   If FCount()>1
     QHelp('...',,1,pVid+pType,'Code',21,25,bPost)
   EndIf
   If (nApp==1.And.MayBlock!=NIL)
     lRet:=Eval(MayBlock)
   EndIf
   Return (lRet)
   Static Function GDel()
   If (MayBlock!=NIL.And.!Eval(MayBlock))
     SayError("Запись задействована в базе данных!")
     Return(.F.)
   EndIf
   Return(.T.)

