Форум

MAKEDIR("C:\testdir")

LOCAL oXml:=HXMLDoc():New("UTF-8")

LOCAL cFilesPath,oMlabelRow 
LOCAL aSet, aSetKey
local oScladMlabel:=ScladMLabelList():Init()
aSet:=SaveSet()
aSetKey:=SaveSetKey()
cFilesPath:='c:\TEMP\'
netuse("TEST",cFilesPath+"TEST.DBF",,.F.)
oMLabelRow := NIL
oScladMLabel := NIL
oScladMlabel:=ScladMLabelList():Init()
oScladMlabel:NewGrupStrat:=1
oScladMlabel:Protocol:=0

TEST->(dbgotop() )
Busy(.T., "MLABEL IS PREPARING...")
do while (TEST->(!eof()))

oMlabelRow:=MlabelRow():Init()
oMlabelRow:Grup :=TEST->GRC
oMlabelRow:Nnum :=ConvToAnsiCp(TEST->NUM)
oMlabelRow:Name :=ConvToAnsiCp(TEST->NAME)
oMlabelRow:FullName :=ConvToAnsiCp(TEST->NAME)
oMlabelRow:NAMECOUNT :=ConvToAnsiCp(TEST->COUNT)
oMlabelRow:Ed :=alltrim('oo.')
oMlabelRow:CODE :=ConvToAnsiCp(TEST->ART)
oScladMlabel:AddMLabel(oMlabelRow)
TEST->(dbskip())
enddo
Busy(.F.)
oScladMLabel:LargeRun() 

RestSet(aSet)
RestSetKey(aSetKey)

Function MyDialog( cMess, cPict, cVar, cZag, cWhen, cValid, cColBox, cRef )
   Local Ret_ := NIL, i,j, lOne:=VALTYPE(cVar)#'A'
   Local nTop, nLeft, nBottom, nRight, nLen
   Local aSet := {SaveSet()}
   Local S
   LOCAL aMess, aPict, aVar, aWhen, aValid, aRef
   Private xVar
   Private GetList := {}
ALTD()
   IF cZag == NIL
      cZag := ''
   ENDIF
   nLen := LEN(cZag)+2
   iIF(VALTYPE(cMess)#'A',cMess:={cMess},NIL)
   iIF(VALTYPE(cPict)#'A',cPict:={cPict},NIL)
   iIF(VALTYPE(cVar)#'A',cVar:={cVar},NIL)
   iIF(VALTYPE(cWhen)#'A',cWhen:={cWhen},NIL)
   iIF(VALTYPE(cValid)#'A',cValid:={cValid},NIL)
   iIF(VALTYPE(cRef)#'A',cRef:={cRef},NIL)
   IF cMess=NIL
      cMess:=ARRAY(LEN(cVar))
      AFILL(cMess,'Введите значение ')
   ENDIF
   IF cColBox = NIL
      cColBox = "N/W"
   ENDIF
   MemVar->xVar:=ARRAY(LEN(cVar))

   IF LEN(cVar)>LEN(cMess)
      aSIZE(cMess,LEN(cVar))
   ENDIF
   IF LEN(cVar)>LEN(cPict)
      aSIZE(cPict,LEN(cVar))
   ENDIF
   IF LEN(cVar)>LEN(cWhen)
      aSIZE(cWhen,LEN(cVar))
   ENDIF
   IF LEN(cVar)>LEN(cValid)
      aSIZE(cValid,LEN(cVar))
   ENDIF
   IF LEN(cVar)>LEN(cRef)
      aSIZE(cValid,LEN(cRef))
   ENDIF
   IF LEN(cVar) >20
      FOR i:=1 TO LEN(cVar) STEP 20
         aMess:={}
         aPict:={}
         aVar:={}
         aWhen:={}
         aValid:={}
         aRef:={}
         FOR j=i TO MIN(LEN(cVar),i+19)
            AADD(aMess,cMess[j])
            AADD(aPict,cPict[j])
            AADD(aVar,cVar[j])
            AADD(aWhen,cWhen[j])
            AADD(aValid,cValid[j])
            AADD(aRef,cRef[j])
         NEXT
         aVar:=MYDIALOG(aMess, aPict, aVar, cZag+' стр.'+STR(i/20+1,2,0), aWhen, aValid, cColBox, aRef )
         IF LASTKEY() = K_ESC
            EXIT
         ELSE
            FOR j=i TO MIN(LEN(cVar),i+19)
               cVar [j]:=   aVar  [j-i+1]
            NEXT
         ENDIF
      NEXT
      Ret_ := ARRAY(LEN(cVar))
      aEVAL(cVar,{|x,i|x:=x,Ret_[i]:=if(LastKey()<>K_ESC,cVar[i],BLANK(cVar[i],.T.))})
   ELSE
      Begin Sequence //ANDKOR
         nTop    := INT((MaxRow()-LEN(cVar))/2) - 1
         nBottom := nTop+LEN(cVar) + 1
         FOR i:=1 to LEN(cVar)
            Do Case
               Case ValType(cVar[i])=="C"
                    nLen := MAX(nLen,;
 X Len( cMess[i] ) + if( Empty(cPict[i]),;
 X IF(LEN(cVar[i])+Len( cMess[i] )>75,;
 X (cPict[i]:='@KS'+TRIM(STR(75-Len( cMess[i] ),2,0)),;
 X 75-Len( cMess[i] )),;
 X LEN(cVar[i])),;
 X Len( TransForm(SPACE(200),cPict[i]))) + 3)
               Case ValType(cVar[i])=="D"
                    nLen := MAX(nLen,Len( cMess[i] ) + 11)
               Case ValType(cVar[i])=="N"
                    nLen := MAX(nLen,Len( cMess[i] ) + if( Empty(cPict[i]),(cPict[i]:='9999999999999.99999',19),Len( TransForm(SPACE(200),cPict[i]))) + 3)
               Case ValType(cVar[i])=="L"
                    nLen := MAX(nLen,Len( cMess[i] ) + 4)
            EndCase
         NEXT
         nLeft   := INT((MaxCol() - nLen)/2)
         nRight  := nLeft + nLen
         SetColor(cColBox)
         ShadowBox(IF(EMPTY(cZag),"",cZag),nTop, nLeft, nBottom, nRight)
         FOR i:=1 to LEN(cVar)
            if( ValType( cMess[i] ) != "C", cMess[i] := "Введите значение", NIL )
            @ nTop+i, nLeft + 2  SAY cMess[i]
            SetCursor(SC_NORMAL)
            MemVar->xVar[i] := cVar[i]
            IF Empty (cRef[i])
             IF EMPTY(cPict[i])
                @nTop+i,nLeft+Len(cMess[i])+3 GET MemVar->xVar[i]
             ELSE
                @nTop+i,nLeft+Len(cMess[i])+3 GET MemVar->xVar[i] PICTURE cPict[i]
             ENDIF
            ELSE
             IF EMPTY(cPict[i])
                @nTop+i,nLeft+Len(cMess[i])+3 REFER cRef[i] GET MemVar->xVar[i]
             ELSE
                @nTop+i,nLeft+Len(cMess[i])+3 REFER cRef[i] GET MemVar->xVar[i] PICTURE cPict[i]
             ENDIF
            ENDIF
            if( !Empty( cWhen[i] ), ATAIL(MemVar->GetList):preblock := &('{||'+cWhen[i]+'}'), NIL )
            if( !Empty( cValid[i] ), ATAIL(MemVar->GetList):postblock := &('{||'+cValid[i]+'}'), NIL )
            ATAIL(MemVar->GetList):display()
         NEXT
         READ
         IF lOne
            Ret_:=if(LastKey()<>K_ESC,MemVar->xVar[1],BLANK(MemVar->xVar[1],.T.))
         ELSE
            Ret_ := ARRAY(LEN(cVar))
            aEVAL(cVar,{|x,i|x,Ret_[i]:=if(LastKey()<>K_ESC,MemVar->xVar[i],BLANK(MemVar->xVar[i],.T.))})
         ENDIF
      Recover USING S  //ANDKOR
      SayError('Ошибка при вводе данных')
      End Sequence //ANDKOR
   ENDIF

   RestSet( aSet[1] )

Return Ret_