//==========================================================================================
*| Empresa      : NSI Softwares e Sites
*| Desenvolvedor: Anderson Vieira
*| Linguagem    : Clipper 5.2
*| Objetivo     : Permitir escolha de campos de um DBF para gerar um relatorio multi-colunas
*|                sem tratamento previo dos campos (selecao feita pelo usuario)
*| Compilar.....: Clipper teste
*| Linkar.......: Rtlink fi teste ou Blinker fi teste
//==========================================================================================
cls

*--array para conter os campos que devem ser selecionados para o relatorio
priv aCmps:={} 

*--largura max do relatorio
largmax=15

*--seu dbf que sera usado no relatorio
use e:\np\banco

*--obtem o total de campos do dbf para coloca-los no array
nTotCmp=FCount()

*--preenche o array dos campos
for i = 1 to nTotCmp
   aadd(aCmps, "[ ] "+Fieldname(i))
next

elemento=1
selecionado:=0;tamCmp:=0

achoice(00,00,10,79,aCmps,"","udfTeste",elemento,elemento)

*--monta o relatorio com os campos selecionados
set printer to "teste.txt"
set print on
set devi to print
set cons off

go top

do while !eof()
   for i = 1 to len(aCmps)
     if substr(aCmps[i],2,1)=chr(7)
       cmp=FieldGet(i)
       
       
       *vlr=cmp
       ?? FieldGET(i) //vlr
       *--espaco entre um campo e outro
       ?? " "
       *exit
     endif
   next
   *--cria um nova linha para por o proximo registro no relatorio
   ?
   
   skip +1
enddo
set printer to 
set print off
set devi to scre
set cons on

*--exibe o relatorio criado.
cls
@00,00 say padc("Relatorio Criado",79) colo "w+/b"
set colo to b/w
memoedit(memoread("Teste.txt"),01,00,24,79)
quit


*--funcao de controle do achoice
function udfTeste
PARAMETERS modo, num_sel, posicao
*--
do case
    case lastkey()=32 
      
         valorfixo=substr(aCmps[num_sel],2,1)
         if valorfixo=chr(7) //check
              aCmps[num_sel]="["+" "+substr(aCmps[num_sel],03,67) 
              
         else
              aCmps[num_sel]="["+chr(7)+substr(aCmps[num_sel],03,67) 
              
         endif
         calclargcmp()

         eleposiciona=num_sel
         keyb chr(1)
         return 2

    case lastkey()=-4
    return 0

    case lastkey()=27
    return 0

    otherwise
    return 2
endcase

*======================
FUNCTION calclargcmp()
*-- objetivo: apenas informar se o relatorio tera o texto trucado
*======================
local tamCmp:=0,selecionado:=0
for jj = 1 to nTotCmp
         
         valorfixo=substr(aCmps[jj],2,1)
         if valorfixo=chr(7) //check
				  if valtype(alltrim(substr(aCmps[jj],05,67)) )=="C"
					  cmp=alltrim(substr(aCmps[jj],05,67))
					  tamCmp+=len(&cmp)
					  elseif valtype(alltrim(substr(aCmps[jj],05,67)) )=="N"
					  cmp=alltrim(substr(aCmps[jj],05,67))
					  tamCmp+=len(str(&cmp))
					  else //logico
					  tamCmp+=1
				  endif
				  selecionado++
         endif
next
*--desconta o espaco entre os campos
tamCmp+=selecionado-1

if tamCmp>LargMax
@24,00 say padc("Largura maxima ultrapassada, o limite e' "+alltrim(padl(LargMax,3))+" caracter(s), texto sera trucando!",80)
else
@24,00 say padc("Permite mais "+alltrim(str(LargMax-tamcmp))+" caracter(s)",80)
endif