PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

Tbrowse com array

https://pctoledo.org/viewtopic.php?t=13490

Página 1 de 1

Tbrowse com array

Enviado: 13 Set 2012 17:00
por cl@udio
Esse código abaixo compila e funciona normalmente em clipper 5.2 e xHarbour Linux 0.99.71.
Porém em xHarbour Windows 1.2.1 só mostra um registro.
Vcs poderiam de me ajudar.
[]s
claudio

Código: Selecionar todos

/******************************************************************
* Procedure: BRW_MATRIZ()
*
* Description: Creates a browse with an array in place of DBF file
*
*              You can do a progressive search in any column 
*              typing the text on any column. To stop it just
*              press any arrow key.
*
* Designed for Clipper 5.x and RtLink but can compile with Harbour
*
* Originaly developed by Paulo Cesar Toledo (Clipper On Line)
* Site: www.pctoledo.com.br
* e-mail: toledo@expressnet.com.br
*
* Hint: For better results execute in a folder with many files
* 
* Little modifications and tranlated to English by Qatan
*
******************************************************************/
#Include "INKEY.CH"
setmode(25,80)
clear
PRIVATE aMatriz1
SET DATE BRITISH
SET CENTURY ON
SET SCOREBOARD OFF
aMatriz1:=DIRECTORY("*.*")  // create array with file information
ASORT(aMatriz1,,,{|x,y| x[1]<y[1]})
J_ANELA(1,12,22,68,"B+/B","N/B","W/B",'['+CURDIR()+']') // 
BRW_MATRIZ(aMatriz1)
retu


PROC BRW_MATRIZ
PARAMETERS brw_mat
brw:=TBrowseNew(4,13,21,67)
private n:= 1, ntot:=len(brw_mat)

brw:colorspec := "W+/B,B/W,W+/R,W+/BG,GR+/GR"
brw:headsep:=chr(205)+chr(209)+chr(205)
brw:colsep:=" "+chr(179)+" "
brw:gotopblock({|| n:= 1})
brw:gobottomblock({|| n:=ntot})
brw:skipblock({|_1| (n:= n + _1, iif(n < 1, _1:= _1 - n + (n:= ;
   1), iif(n > ntot, _1:= _1 - (n - (n:= ;
   ntot)), Nil)), _1)})


brw:addcolumn(tbcolumnnew("File",{|| TRANS(brw_mat[n,1],"@!")}))
brw:getcolumn(1):width := 12
brw:getcolumn(1):cargo := {"@!"}
brw:addcolumn(tbcolumnnew("Size",{|| TRANS(brw_mat[n,2],"@E 99,999,999")}))
brw:getcolumn(2):width := 10
brw:getcolumn(2):cargo := {"@E 99,999,999"}
brw:addcolumn(tbcolumnnew("Date",{|| TRANS(brw_mat[n,3],"@D")}))
brw:getcolumn(3):width := 10
brw:getcolumn(3):cargo := {"@!"}
brw:addcolumn(tbcolumnnew("Time",{|| TRANS(brw_mat[n,4],"@!")}))
brw:getcolumn(4):width := 8
brw:getcolumn(4):cargo := {"@!"}
volta_db=.t.
st_pesq:=""
idx=1
DO WHILE volta_db
   SETCOLOR("W+/B")
   SET CURSO OFF
   e=1
   DO WHILE !brw:stabilize() .AND. NEXTKEY()=0
   ENDD
   READINSERT(.f.)
   x_ = COL() ; y_ = ROW()
   IF LEN(st_pesq)>0
      cp_:=brw_mat[n,brw:colpos]
      cp_masc:=brw:getcolumn(brw:colpos):cargo()[1]
      IF LEN(st_pesq) <= brw:getcolumn(brw:colpos):width
         i_=SETCOLOR("GR+/GR")
         t=1
         l_m=TRAN(cp_,cp_masc)
         FOR j=1 TO LEN(l_m)
            IF SUBS(st_pesq,t,1)=SUBS(l_m,j,1)
               t++
               IF t>LEN(st_pesq)
                  @ y_,x_ SAY LEFT(l_m,j)
                  EXIT
               ENDI
            ENDI
         NEXT
         SETCOLOR(i_)
      ENDI
   ENDI
   
   tecl_p=INKEY(0)
   carac_ = UPPER(CHR(tecl_p))
   IF tecl_p>31
         st_p=st_pesq+carac_
         cp_:=brw_mat[n,brw:colpos]
         tp_cp:=VALTYPE(cp_)
         IF idx!=brw:colpos
          IF tp_cp="D"
            ASORT(brw_mat,,,{|x,y| DTOS(x[brw:colpos])<DTOS(y[brw:colpos])})
          ELSEIF tp_cp="N"
            ASORT(brw_mat,,,{|x,y| STR(x[brw:colpos])<STR(y[brw:colpos])})
          ELSE
            ASORT(brw_mat,,,{|x,y| x[brw:colpos]<y[brw:colpos]})
          ENDIF
          idx:=brw:colpos
         ENDIF
         brw:RefreshAll()
         IF tp_cp="D"
           op=ASCAN(brw_mat,{|e| st_p==LEFT(DTOC(e[brw:colpos]),len(st_p))})
         ELSEIF tp_cp="N"
           op=ASCAN(brw_mat,{|e| st_p==LEFT(LTRIM(STR(e[brw:colpos])),len(st_p))})         
         ELSE
           op=ASCAN(brw_mat,{|e| st_p==LEFT(e[brw:colpos],len(st_p))})         
         ENDIF
         IF op>0
          st_pesq=st_p
          n:=op
          brw:rowpos=1
          brw:configure()
         ELSE
          TONE(400,2)
         ENDIF
         LOOP
   ENDIF
   SET CURSO ON
   brw:dehilite()
   DO CASE
         CASE tecl_p = K_ESC
            volta_db=.f.
         CASE tecl_p = K_UP
              brw:up()
         CASE tecl_p = K_DOWN
            brw:down()
         CASE tecl_p = K_RIGHT
            brw:right()
         CASE tecl_p = K_LEFT
            brw:left()
         CASE tecl_p = K_HOME   
            brw:home()
         CASE tecl_p = K_END   
            brw:end()
         CASE tecl_p = K_PGUP   
            brw:pageup()
         CASE tecl_p = K_PGDN   
            brw:pagedown()
         CASE tecl_p = K_CTRL_PGDN
            brw:gobottom()
         CASE tecl_p = K_CTRL_PGUP
            brw:gotop()
         CASE tecl_p = K_CTRL_END   
            brw:panend()
         CASE tecl_p = K_CTRL_HOME   
            brw:panhome()
         CASE tecl_p = K_CTRL_LEFT   
            brw:panleft()
         CASE tecl_p = K_CTRL_RIGHT   
            brw:panright()
            

   ENDC
   st_pesq=""
ENDD
SET CURSO ON
setcolor('')
cls
RETU

FUNCTION J_ANELA
PARAMETERS L1,C1,L2,C2,C_OR1,C_OR2,C_OR3,T_ITULO
CORR=SETCOLOR()
SET COLOR TO &C_OR1
@ L1,C1 CLEAR TO L2,C2
@ L1,C1 SAY 'Ú'+REPLICATE(CHR(196),C2-C1-1)+'¿'
SET COLOR TO &C_OR3
@ L1,(80-LEN(T_ITULO))/2 SAY T_ITULO
FOR A=L1+1 TO L2-1
   SET COLOR TO &C_OR1
   @ A,C1 SAY '³'
   SET COLOR TO &C_OR2
   @ A,C2 SAY '³'
NEXT A
SET COLOR TO &C_OR2
@ L2,C1 SAY 'À'+REPLICATE(CHR(196),C2-C1-1)+'Ù'
SETCOLOR(CORR)
RETURN

Tbrowse com array

Enviado: 13 Set 2012 17:20
por Pablo César
Baixei o código novamente, pois continham vários erros. Veja se é esse o mesmo resultado que você espera:

Código: Selecionar todos

#Include "INKEY.CH"

REQUEST HB_GT_WIN_DEFAULT

Function Main
/******************************************************************
* Rotina: BRW_MATRIZ()
* Descricao: Monta um browse com uma matriz no lugar do arquivo
*            DBF.  Faz um pesquisa sequencial digitando o texto
*            que voce quer procurar, em qualquer das colunas do
*            browse. Para comecar uma nova pesquisa, utilize uma
*            das setas para quebrar a sequencia da pesquisa, por
*            exemplo: seta para baixo.
* Versao do Clipper: 5.01 ou superior
* Para compilar o exemplo: CLIPPER BRWM
*                          RTLINK FI BRWM
* 
* Rotina desenvolvida pelo site: Clipper On Line - Toledo
* Endereco: www.pctoledo.com.br
* Para testar esta rotina, execute em uma pasta onde tem vários
* arquivos.
******************************************************************/

PRIVATE aMatriz1

setmode(25,80)
cls
PRIVATE aMatriz1
SET DATE BRITISH
SET CENTURY ON
SET SCOREBOARD OFF
aMatriz1:=DIRECTORY("*.*")  // cria uma matriz com os dados dos arquivos
ASORT(aMatriz1,,,{|x,y| x[1]<y[1]})
J_ANELA(2,12,20,68,"B+/B","N/B","W/B"," (ARQUIVOS DO DIRETORIO) ")
BRW_MATRIZ(aMatriz1)
retu


PROC BRW_MATRIZ
PARAMETERS brw_mat
brw:=TBrowseNew(3,13,19,67)
private n:= 1, ntot:=len(brw_mat)

brw:colorspec := "W+/B,B/W,W+/R,W+/BG,GR+/GR"
brw:headsep:=chr(205)+chr(209)+chr(205)
brw:colsep:=" "+chr(179)+" "
brw:gotopblock({|| n:= 1})
brw:gobottomblock({|| n:=ntot})
brw:skipblock({|_1| (n:= n + _1, iif(n < 1, _1:= _1 - n + (n:= ;
   1), iif(n > ntot, _1:= _1 - (n - (n:= ;
   ntot)), Nil)), _1)})


brw:addcolumn(tbcolumnnew("Arquivo",{|| TRANS(brw_mat[n,1],"@!")}))
brw:getcolumn(1):width := 12
brw:getcolumn(1):cargo := {"@!"}
brw:addcolumn(tbcolumnnew("Tamanho",{|| TRANS(brw_mat[n,2],"@E 99,999,999")}))
brw:getcolumn(2):width := 10
brw:getcolumn(2):cargo := {"@E 99,999,999"}
brw:addcolumn(tbcolumnnew("Data",{|| TRANS(brw_mat[n,3],"@D")}))
brw:getcolumn(3):width := 10
brw:getcolumn(3):cargo := {"@!"}
brw:addcolumn(tbcolumnnew("Hora",{|| TRANS(brw_mat[n,4],"@!")}))
brw:getcolumn(4):width := 8
brw:getcolumn(4):cargo := {"@!"}
volta_db=.t.
st_pesq:=""
idx=1
DO WHILE volta_db
   SETCOLOR("W+/B")
   SET CURSO OFF
   e=1
   DO WHILE !brw:stabilize() .AND. NEXTKEY()=0
   ENDD
   READINSERT(.f.)
   x_ = COL() ; y_ = ROW()
   IF LEN(st_pesq)>0
      cp_:=brw_mat[n,brw:colpos]
      cp_masc:=brw:getcolumn(brw:colpos):cargo()[1]
      IF LEN(st_pesq) <= brw:getcolumn(brw:colpos):width
         i_=SETCOLOR("GR+/GR")
         t=1
         l_m=TRAN(cp_,cp_masc)
         FOR j=1 TO LEN(l_m)
            IF SUBS(st_pesq,t,1)=SUBS(l_m,j,1)
               t++
               IF t>LEN(st_pesq)
                  @ y_,x_ SAY LEFT(l_m,j)
                  EXIT
               ENDI
            ENDI
         NEXT
         SETCOLOR(i_)
      ENDI
   ENDI
   
   tecl_p=INKEY(0)
   carac_ = UPPER(CHR(tecl_p))
   IF tecl_p>31
         st_p=st_pesq+carac_
         cp_:=brw_mat[n,brw:colpos]
         tp_cp:=VALTYPE(cp_)
         IF idx!=brw:colpos
          IF tp_cp="D"
            ASORT(brw_mat,,,{|x,y| DTOS(x[brw:colpos])<DTOS(y[brw:colpos])})
          ELSEIF tp_cp="N"
            ASORT(brw_mat,,,{|x,y| STR(x[brw:colpos])<STR(y[brw:colpos])})
          ELSE
            ASORT(brw_mat,,,{|x,y| x[brw:colpos]<y[brw:colpos]})
          ENDIF
          idx:=brw:colpos
         ENDIF
         IF tp_cp="D"
           op=ASCAN(brw_mat,{|e| st_p==LEFT(DTOC(e[brw:colpos]),len(st_p))})
         ELSEIF tp_cp="N"
           op=ASCAN(brw_mat,{|e| st_p==LEFT(LTRIM(STR(e[brw:colpos])),len(st_p))})         
         ELSE
           op=ASCAN(brw_mat,{|e| st_p==LEFT(e[brw:colpos],len(st_p))})         
         ENDIF
         IF op>0
          st_pesq=st_p
          n:=op
          brw:rowpos=1
          brw:configure()
         ELSE
          TONE(400,2)
         ENDIF
         LOOP
   ENDIF
   SET CURSO ON
   brw:dehilite()
   DO CASE
         CASE tecl_p = K_ESC
            volta_db=.f.
         CASE tecl_p = K_UP
              brw:up()
         CASE tecl_p = K_DOWN
            brw:down()
         CASE tecl_p = K_RIGHT
            brw:right()
         CASE tecl_p = K_LEFT
            brw:left()
         CASE tecl_p = K_HOME   
            brw:home()
         CASE tecl_p = K_END   
            brw:end()
         CASE tecl_p = K_PGUP   
            brw:pageup()
         CASE tecl_p = K_PGDN   
            brw:pagedown()
         CASE tecl_p = K_CTRL_PGDN
            brw:gobottom()
         CASE tecl_p = K_CTRL_PGUP
            brw:gotop()
         CASE tecl_p = K_CTRL_END   
            brw:panend()
         CASE tecl_p = K_CTRL_HOME   
            brw:panhome()
         CASE tecl_p = K_CTRL_LEFT   
            brw:panleft()
         CASE tecl_p = K_CTRL_RIGHT   
            brw:panright()
            

   ENDC
   st_pesq=""
ENDD
SET CURSO ON
RETU

FUNCTION J_ANELA
PARAMETERS L1,C1,L2,C2,C_OR1,C_OR2,C_OR3,T_ITULO
CORR=SETCOLOR()
SET COLOR TO &C_OR1
@ L1,C1 CLEAR TO L2,C2
@ L1,C1 SAY 'Ú'+REPLICATE(CHR(196),C2-C1-1)+'¿'
SET COLOR TO &C_OR3
@ L1,(80-LEN(T_ITULO))/2 SAY T_ITULO
FOR A=L1+1 TO L2-1
   SET COLOR TO &C_OR1
   @ A,C1 SAY '³'
   SET COLOR TO &C_OR2
   @ A,C2 SAY '³'
NEXT A
SET COLOR TO &C_OR2
@ L2,C1 SAY 'À'+REPLICATE(CHR(196),C2-C1-1)+'Ù'
SETCOLOR(CORR)
RETURN
Só que eu compilei em Harbour através da IDE da HMG, está funcionando e aqui em anexo.

Tbrowse com array

Enviado: 13 Set 2012 17:25
por cl@udio
Ola Pablo Cézar

Obrigado por analisar. Neste seu exemplo a busca por letra a letra não funciona mais. Mas vou analisar o codigo.
[]s
claudio

Tbrowse com array

Enviado: 13 Set 2012 18:00
por Pablo César
Substitua a linha 127 por esta linha:

op=ASCAN(brw_mat,{|e| Upper(st_p)==Upper(LEFT(e[brw:colpos],len(st_p)))})

Para localização, sempre é bom tratar as string de forma uniforme, seja sempre em maiusculas ou sempre em minusculas. Isso diminui a possibilidades de estarem de forma mixta. É o que aconteceu com o nome dos arquivos.

Tbrowse com array

Enviado: 14 Set 2012 11:02
por cl@udio
Só uma duvida, vc esta compilando com o harbour. Estou compilando com xharbour e esta na mesma.
Me desculpa só agora fui ver q vc compilou com harbour, mas precisa ver isto xharbour para windows.
[]s
claudio
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB