PC Toledo

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

Solução para o problema do Dbedit na Migração para xHarbour

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

Página 1 de 1

Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 16 Fev 2008 19:21
por marcelomgoncalves
Caros colegas depois de compilar meu sistema com o xharbour notei que as funções que usavam a dbedit estavam executando um pouco diferente, as vezes a tela ficava em branco, quando eu teclava enter aí mostrava os dados, sem falar em algumas outras coisas meio malucas que aconteciam, bom descompilei um de meus sistemas compilados com clipper e isolei as funções usadas pela dbedit e a própria dbedit, assim estou colocando-os aqui, basta copiá-las para um arquivo e compilar junto com seu sistema, elas irão se sobrepor a dbedit do xharbour, fazendo com que o funcionamento seja igual ao do clipper 5.2e. ou você tb pode fazer igual a mim e compilar este arquivo com o xharbour e criar uma lib só pra dbedit, sinta-se a vontade para fazer do seu jeito.

segue o código abaixo...

Código: Selecionar todos

#Include "common.ch"
#Include "inkey.ch"
#Include "button.ch"
#Include "setcurs.ch"
#Include "color.ch"
#Include "hbsetup.ch"
#Include "dbedit.ch"

STATIC Static12,Static13

FUNCTION DBEDIT(Arg1,Arg2,Arg3,Arg4,Arg5,Arg6,Arg7,Arg8,Arg9,Arg10,Arg11,Arg12)
 LOCAL Local1,Local2,Local3,Local4,Local5,Local6,Local7

 *** FOI PRECISO CRIAR ESTA SECAO PARA INICIALIZACAO DOS ARGUMENTOS
 *** COM UM VALOR DEFAULT, POIS QUANDO COMPILADO COM XHARBOUR
 *** AS LINHAS DE SEPARACAO DE HEADSEP E COLSEP NAO ESTAVAM APARECENDO

 DEFAULT ARG9 TO chr(196)+chr(194)+chr(196)
 DEFAULT ARG10 TO " "+CHR(179)+" "
 DEFAULT ARG11 TO " "
 DEFAULT ARG12 TO " " 

 IF EOF()
  GOTO BOTTOM
 ENDIF
 Local1:=DBEDSETUP(Arg1,Arg2,Arg3,Arg4,Arg5,Arg6,Arg7,Arg8,Arg9,Arg10,Arg11,Arg12)
 Local1:SKIPBLOCK({| _1 | SKIPPED(_1)})
 Local1:AUTOLITE(.F.)
 Local2:=SETCURSOR(0)
 Local7:={Static12,Static13}
 Static12:=.F.
 Static13:=.T.
 Local5:=.T.
 Local3:=.T.
 DO WHILE Local3
  DO WHILE !Local1:STABILIZE()
   IF NEXTKEY() <> 0
    EXIT
   ENDIF
  ENDDO
  IF (Local4:=INKEY()) == 0
   IF Local5
    Local3:=CALLUSER(Local1,Arg6,0)
    DO WHILE !Local1:STABILIZE()
    ENDDO
   ENDIF
   IF Local3 .AND. Static13
    Local1:HILITE()
    Local4:=INKEY(0)
    Local1:DEHILITE()
    IF (Local6:=SETKEY(Local4)) <> Nil
     EVAL(Local6,PROCNAME(1),PROCLINE(1),"")
     LOOP
    ENDIF
   ELSE
    Static13:=.T.
   ENDIF
  ENDIF
  Local5:=.T.
  DO CASE
  CASE Local4==0
  CASE Local4==24
   IF Static12
    Local1:HITBOTTOM(.T.)
   ELSE
    Local1:DOWN()
   ENDIF
  CASE Local4==5
   IF Static12
    Local1:HITTOP(.T.)
   ELSE
    Local1:UP()
   ENDIF
  CASE Local4==3
   IF Static12
    Local1:HITBOTTOM(.T.)
   ELSE
    Local1:PAGEDOWN()
   ENDIF
  CASE Local4==18
   IF Static12
    Local1:HITTOP(.T.)
   ELSE
    Local1:PAGEUP()
   ENDIF
  CASE Local4==31
   IF Static12
    Local1:HITTOP(.T.)
   ELSE
    Local1:GOTOP()
   ENDIF
  CASE Local4==30
   IF Static12
    Local1:HITBOTTOM(.T.)
   ELSE
    Local1:GOBOTTOM()
   ENDIF
  CASE Local4==4
   Local1:RIGHT()
  CASE Local4==19
   Local1:LEFT()
  CASE Local4==1
   Local1:HOME()
  CASE Local4==6
   Local1:END()
  CASE Local4==26
   Local1:PANLEFT()
  CASE Local4==2
   Local1:PANRIGHT()
  CASE Local4==29
   Local1:PANHOME()
  CASE Local4==23
   Local1:PANEND()
  OTHERWISE
   Local3:=CALLUSER(Local1,Arg6,Local4)
   Local5:=.F.
  ENDCASE
 ENDDO
 SETCURSOR(Local2)
 Static12:=Local7[1]
 Static13:=Local7[2]
 RETURN .T.

********************************
FUNCTION DBEDSETUP(Arg1,Arg2,Arg3,Arg4,Arg5,Arg6,Arg7,Arg8,Arg9,Arg10,Arg11,Arg12)

 LOCAL Local1,Local2,Local3,Local4,Local5,Local6,Local7,Local8

 IF VALTYPE(Arg1) <> "N" .OR. Arg1 < 0
  Arg1:=0
 ENDIF
 IF VALTYPE(Arg2) <> "N" .OR. Arg2 < 0
  Arg2:=0
 ENDIF
 IF VALTYPE(Arg3) <> "N" .OR. Arg3 > MAXROW() .OR. Arg3 < Arg1
  Arg3:=MAXROW()
 ENDIF
 IF VALTYPE(Arg4) <> "N" .OR. Arg4 > MAXCOL() .OR. Arg4 < Arg2
  Arg4:=MAXCOL()
 ENDIF
 IF (Arg4-Arg2)*(Arg3-Arg1) > MAXROW()*MAXCOL()
  Arg1:=Arg2:=0
  Arg3:=MAXROW()
  Arg4:=MAXCOL()
 ENDIF
 Local1:=TBROWSEDB(Arg1,Arg2,Arg3,Arg4)
 IF ISARRAY(Arg5)
  Local3:=LEN(Arg5)
  Local2:=1
  DO WHILE Local2 <= Local3
   IF VALTYPE(Arg5[Local2]) <> "C" .OR. EMPTY(Arg5[Local2])
    EXIT
   ENDIF
   Local2++
  ENDDO
  Local3:=Local2-1
 ELSE
  Local3:=FCOUNT()
 ENDIF
 IF Local3 == 0
  RETURN .F.
 ENDIF
 Local1:HEADSEP("ÍÑÍ")
 Local1:COLSEP(" ³ ")
 Local4:=ARRAY(Local3,6)
 IF ISARRAY(Arg5)
  FOR Local2:=1 TO Local3
   IF "->" $ Arg5[Local2]
    Local6:=AT("->",Arg5[Local2])
    Local4[Local2][3]:=SUBSTR(Arg5[Local2],1,Local6-1)
    Local4[Local2][4]:=SUBSTR(Arg5[Local2],Local6+2)
    Local4[Local2][1]:=Local4[Local2][3]+"->;"+Local4[Local2][4]
   ELSE
    Local4[Local2][3]:=Nil
    Local4[Local2][4]:=Nil
    Local4[Local2][1]:=Arg5[Local2]
   ENDIF
   Local4[Local2][2]:=Arg5[Local2]
  NEXT
 ELSEIF FCOUNT() > 0
  FOR Local2:=1 TO Local3
   Local4[Local2][3]:=Nil
   Local4[Local2][4]:=Nil
   Local4[Local2][1]:=FIELDNAME(Local2)
   Local4[Local2][2]:=FIELDNAME(Local2)
  NEXT
 ELSE
  RETURN .F.
 ENDIF
 FOR Local2:=1 TO Local3
  Local5:=""
  IF ISARRAY(Arg7)
   IF LEN(Arg7) >= Local2 .AND. ISCHARACTER(Arg7[Local2]) .AND. !EMPTY(Arg7[Local2])
    Local5:=Arg7[Local2]
   ENDIF
  ELSEIF ISCHARACTER(Arg7) .AND. !EMPTY(Arg7)
   Local5:=Arg7
  ENDIF
  Local7:=Nil
  IF ISMEMO(&(Local4[Local2][2]))
   Local7:="{|| '  <Memo>  '}"
  ELSEIF EMPTY(Local5)
   IF "->" $ Local4[Local2][2]
    IF UPPER(Local4[Local2][3]) == "M"
     Local7:=MEMVARBLOCK(Local4[Local2][2])
    ELSEIF UPPER(Local4[Local2][3]) == "FIELD"
     Local7:=FIELDWBLOCK(Local4[Local2][4],SELECT())
    ELSE
     Local7:=FIELDWBLOCK(Local4[Local2][4],SELECT(Local4[Local2][3]))
    ENDIF
   ELSEIF !EMPTY(FIELDPOS(Local4[Local2][2]))
    Local7:=FIELDWBLOCK(Local4[Local2][2],SELECT())
   ENDIF
  ENDIF
  IF ISNIL(Local7)
   IF EMPTY(Local5)
    Local7:="{||"+Local4[Local2][2]+"}"
   ELSE
    Local7:="{|| Transform("+Local4[Local2][2]+",'"+Local5+"')}"
   ENDIF
  ENDIF
  IF ISCHARACTER(Local7)
   Local4[Local2][2]:=&Local7
  ELSEIF ISBLOCK(Local7)
   Local4[Local2][2]:=Local7
  ENDIF
  IF ISARRAY(Arg8)
   IF LEN(Arg8) >= Local2 .AND. ISCHARACTER(Arg8[Local2])
    Local4[Local2][1]:=Arg8[Local2]
   ENDIF
  ELSEIF ISCHARACTER(Arg8)
   Local4[Local2][1]:=Arg8
  ENDIF
  Local4[Local2][3]:=Nil
  IF ISARRAY(Arg9)
   IF LEN(Arg9) >= Local2 .AND. ISCHARACTER(Arg9[Local2])
    Local4[Local2][3]:=Arg9[Local2]
   ENDIF
  ELSEIF ISCHARACTER(Arg9)
   Local4[Local2][3]:=Arg9
  ENDIF
  Local4[Local2][4]:=Nil
  IF ISARRAY(Arg10)
   IF LEN(Arg10) >= Local2 .AND. ISCHARACTER(Arg10[Local2])
    Local4[Local2][4]:=Arg10[Local2]
   ENDIF
  ELSEIF ISCHARACTER(Arg10)
   Local4[Local2][4]:=Arg10
  ENDIF
  Local4[Local2][5]:=Nil
  IF ISARRAY(Arg11)
   IF LEN(Arg11) >= Local2 .AND. ISCHARACTER(Arg11[Local2])
    Local4[Local2][5]:=Arg11[Local2]
   ENDIF
  ELSEIF ISCHARACTER(Arg11)
   Local4[Local2][5]:=Arg11
  ENDIF
  Local4[Local2][6]:=Nil
  IF ISARRAY(Arg12)
   IF LEN(Arg12) >= Local2 .AND. ISCHARACTER(Arg12[Local2])
    Local4[Local2][6]:=Arg12[Local2]
   ENDIF
  ELSEIF ISCHARACTER(Arg12)
   Local4[Local2][6]:=Arg12
  ENDIF
 NEXT
 FOR Local2:=1 TO Local3
  Local8:=TBCOLUMNNEW(Local4[Local2][1],Local4[Local2][2])
  IF Local4[Local2][3] <> Nil
   Local8:HEADSEP(Local4[Local2][3])
  ENDIF
  IF Local4[Local2][4] <> Nil
   Local8:COLSEP(Local4[Local2][4])
  ENDIF
  IF Local4[Local2][5] <> Nil
   Local8:FOOTSEP(Local4[Local2][5])
  ENDIF
  IF Local4[Local2][6] <> Nil
   Local8:FOOTING(Local4[Local2][6])
  ENDIF
  Local1:ADDCOLUMN(Local8)
 NEXT
 RETURN Local1

********************************
FUNCTION CALLUSER(Arg1,Arg2,Arg3)

 LOCAL Local1,Local2,Local3,Local4
 IF Arg3 <> 0
  Local1:=4
 ELSEIF !Static12 .AND. EMPTYFILE()
  Local1:=3
 ELSEIF Arg1:HITBOTTOM()
  Local1:=2
 ELSEIF Arg1:HITTOP()
  Local1:=1
 ELSE
  Local1:=0
 ENDIF
 DO WHILE !Arg1:STABILIZE()
 ENDDO
 Local3:=RECNO()
 IF VALTYPE(Arg2) <> "C" .OR. EMPTY(Arg2)
  IF Arg3 == 13 .OR. Arg3 == 27
   Local2:=0
  ELSE
   Local2:=1
  ENDIF
 ELSE
  Local2:=&Arg2(Local1,Arg1:COLPOS())
 ENDIF
 Local4:=Local2 <> 0
 IF !Static12 .AND. EOF() .AND. !EMPTYFILE()
  SKIP -1
 ENDIF
 IF Local2 == 3
  Static12:=!(Static12 .AND. EOF())
  IF Static12
   GOTO BOTTOM
   Arg1:DOWN()
  ELSE
   Arg1:REFRESHCURRENT()
  ENDIF
  Static13:=.F.
 ELSEIF Local2 == 2 .OR. Local3 <> RECNO()
  IF Local4
   Static12:=.F.
   IF SET(_SET_DELETED) .AND. DELETED() .OR. !EMPTY(DBFILTER()) .AND. !&(DBFILTER())
    SKIP 
   ENDIF
   IF EOF()
    GOTO BOTTOM
   ENDIF
   Local3:=RECNO()
   Arg1:REFRESHALL()
   DO WHILE !Arg1:STABILIZE()
   ENDDO
   DO WHILE Local3 <> RECNO()
    Arg1:UP()
    DO WHILE !Arg1:STABILIZE()
    ENDDO
   ENDDO
   Static13:=.F.
  ENDIF
 ELSE
  Arg1:REFRESHCURRENT()
 ENDIF
 RETURN Local4

********************************
FUNCTION SKIPPED(Arg1)

 LOCAL Local1
 Local1:=0
 IF LASTREC() <> 0
  IF Arg1 == 0
   IF EOF() .AND. !Static12
    SKIP -1
    Local1:=-1
   ELSE
    SKIP 0
   ENDIF
  ELSEIF Arg1 > 0 .AND. RECNO() <> LASTREC()+1
   DO WHILE Local1 < Arg1
    SKIP 
    IF EOF()
     IF Static12
      Local1++
     ELSE
      SKIP -1
     ENDIF
     EXIT
    ENDIF
    Local1++
   ENDDO
  ELSEIF Arg1 < 0
   DO WHILE Local1 > Arg1
    SKIP -1
    IF BOF()
     EXIT
    ENDIF
    Local1--
   ENDDO
  ENDIF
 ENDIF
 RETURN Local1


FUNCTION EMPTYFILE

 IF LASTREC() == 0
  RETURN .T.
 ENDIF
 IF (EOF() .OR. RECNO() == LASTREC()+1) .AND. BOF()
  RETURN .T.
 ENDIF
 RETURN .F.

********************************
------------------------------------
Nota da Moderação (Sygecom): Foi colocado o Codigo dentro da TAG [ CODE ]

Re: Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 06 Jul 2009 00:31
por lugab
Parabéns, Marcelo, funcionou redondo. Parabéns e obrigado por compartilhar conosco

Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 05 Set 2012 20:50
por luizhsantos
Cara! Acabei de converter um sistema clipper para harbour e me deparei com essa incompatibilidade do DBEDIT. Peguei sua dica, seu código e compilei junto com os outros fontes e pronto. Resolvido...

MUITO obrigado pela sua ajuda.

Caraca. Agora que eu vi. Tu postou isso em 2008 e estamos em 2012.

Abraços,

Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 05 Set 2012 21:31
por lugab
Eu venho usando essa rotina, já faz tempo, e notei uma única coisa errada:

Ela apaga o conteúdo do que houver impresso entre as colunas 64 e 70 da linha zero da tela

Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 21 Set 2012 16:13
por braz
Eu nunca tive problemas com o Dbedit em xHarbor, eu uso o Xedit para trabalhar e compilar.

Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 09 Jul 2013 16:21
por leandrolinauer
Boa tarde a todos.
Eu estou com este mesmo problema, a grid não aparece com o dbedit e nem com a tbrowse, simplesmente não separa as colunas e linhas.
Baixei a dbedit compilei no programa e nada.

Alguem sabe como arrumar
Lembrando que só ocorreu este problema comigo depois de eu começar a usar o HARBOUR, no xharbour funcionava, mas eu preciso do HARBOUR.
Grato
-:]

Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 09 Jul 2013 18:19
por fladimir
Leandro e demais colegas eu tive esses problemas na época em q usava o xHarbour pra resolver eu compilei juntamente com meu projeto o dbedit.prg, mas olhando rapidamente não encontrei, mas lembro q peguei aki no fórum e resolveu, se eu achar depois volto a postar...

Resumindo só resolveu em xHarbour compilando o dbedit.prg q disponibilizaram na época aki no fórum junto com meu projeto.

Em Harbour não precisei.

[]´s

Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 10 Jul 2013 10:01
por leandrolinauer
Bom dia Fladimir.
Em xHarbour eu não precisei, funcionou perfeitamente o DBEDIT, com as linhas de separação, já no harbour quando migrei para ele por necessidade de usar o sqlite3, me deparei com este problema e nunca consegui arrumar, simplesmente as linhas ficam fora do grid.

Abaixo imagem do Edit com TbrowseNew em Harbour 3.1, ocorre o mesmo com TbrowseDB e o DBEDIT.
Imagem

Abaixo imagem do Dbedit próprio no xharbour simplex
Imagem


Ja tentei de tudo e nada, inclusive no Harbour 3.1 a imagem da coluna da grid saem para baixo da tela de edição dos dados, para por exemplo em cima aonde digito a pesquisa, muitas vezes apagando algumas letras aonde ela passa.
Eu coloquei cor branca e cinza intercaladas para não misturar as colunas, foi a unica coisa que deu certo para suprir o problema.


Fico grato pela ajuda.
-:]

Solução para o problema do Dbedit na Migração para xHarbour

Enviado: 10 Jul 2013 14:39
por asimoes
Pessoal,

Estou usando com o harbour 3.2 compilado recentemente e não tenho esse problema na separação das colunas.
Veja a imagem:

Imagem

Código: Selecionar todos

STATIC FUNCTION DbData(nLinI,nColI,nLinF,nColF)

   oTBrowse:=TBrowseDB(nLinI,nColI,nLinF,nColF)

   oColuna:=TBColumnNew( "Mˆs/Ano", {|| SubStr(APA01->AnoMes,3,2)+APA01->NovoAno})
   oColuna:picture:="@R 99/9999"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "T", {|| APA01->t_guia})
   oColuna:picture:="X"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "S", {|| APA01->loc_pag})
   oColuna:picture:="X"
   //oColuna:colorBlock:={||IF(APA01->loc_pag = "B",{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew("  Vencto. ", {|| " "+HB_DTOC(APA01->d_venc,"DDMMYY")})
   oColuna:picture:= "@R 999/99/99 "
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "Vlr.Total", {|| APA01->vl_guia})
   //oColuna:picture:="@E 999,999,999.99"
   oColuna:picture:="@E 999,999.99"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "Vlr.Pago", {|| APA01->vl_pgto})
   oColuna:picture:="@E 999,999.99"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "Acresc(Red)", {|| APA01->acr_red})
   oColuna:picture:="@E 999,999.99"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "Data Pgt.", {|| " "+HB_DTOC(APA01->d_pgto,"DDMMYY")})
   oColuna:picture:="@R 999/99/99 "
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "Nr.do Banco", {|| APA01->nr_banco})
   oColuna:picture:="@R 999999999999/9"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "CB", {|| APA01->em_cobr})
   oColuna:picture:="X"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "EC", {|| APA01->ent_conf})
   oColuna:picture:="X"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "BS", {|| APA01->baix_sol})
   oColuna:picture:="X"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "BC", {|| APA01->baix_conf})
   oColuna:picture:="X"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "Pc.Multa", {|| APA01->pc_multa})
   oColuna:picture:="@E 99.99"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   oColuna:=TBColumnNew( "RD", {|| APA01->rc_dg_ass})
   oColuna:picture:="X"
   //oColuna:colorBlock:={||IF(Empty(d_pgto) .AND. (date()-d_venc) > 30,{4,1},{1,1})}
   oTBrowse:addColumn( oColuna )

   FOR I:=1 TO oTBrowse:ColCount
      oTBrowse:GetColumn(I):colorBlock:={||IF(Empty(APA01->d_pgto) .AND. (Date()-APA01->d_venc) > 30,{1,1},{1,1})}
   NEXT

   oTBrowse:cargo:={|| DiasAtraso("APA01")}

   oTBrowse:headSep   := Chr(196)
   //oTBrowse:footSep   := Chr(196)

   oTBrowse:colSep    := Chr(178)

   //oTBrowse:colorSpec :="W+/BG,W+/R*,W+/B*,W+/R*"
   
   oTBrowse:colorSpec :="W+/B,B/GB*,B/W*,W+/R*"
   
   oTBrowse:freeze:=1
   
   oTBrowse:DeHilite()
   
   aRect := {oTBrowse:RowPos,1,oTBrowse:RowPos,oTBrowse:ColCount}
   
   Cursor("OFF")

   DO WHILE .T.

      DbSelectArea("APA01")      
      
      IF (oTBrowse:colPos <= oTBrowse:freeze)
         oTBrowse:colPos := oTBrowse:freeze + 1
      ENDIF
      
      oTBrowse:colorRect({oTBrowse:rowPos, 1,oTBrowse:rowPos, 1}, IF(Empty(APA01->d_pgto) .AND. (Date()-APA01->d_venc) > 30,{1,1},{1,1}))

      oTBrowse:colorRect({oTBrowse:rowPos, oTBrowse:freeze + 1,oTBrowse:rowPos, oTBrowse:colCount},IF(Empty(APA01->d_pgto) .AND. (Date()-APA01->d_venc) > 30,{1,1},{1,1}))

      ForceStable(oTBrowse )

      IF ( oTBrowse:stable )

         oTBrowse:colorRect({oTBrowse:rowPos, 1,oTBrowse:rowPos, 1},IF(Empty(APA01->d_pgto) .AND. (Date()-APA01->d_venc) > 30,{3,2},{3,2}))

         oTBrowse:colorRect({oTBrowse:rowPos,oTBrowse:freeze + 1, oTBrowse:rowPos,oTBrowse:colCount}, {3,2})

         oTBrowse:hilite()

         Mensagem(oTBrowse:colpos,"A440300")

         IF lPrimeiro
            IF !APA01->(DbSeek(AllTrim(cCodigo)))
               MensagemSistema("NÆo existe guia para este associado.","Aten‡Æo",90,500,2,.T.)
               RETURN Nil
            ENDIF
            lPrimeiro:=.F.
         ENDIF
         IF APA01->Codigo # cCodigo
            nCol:=Col()
            nRow:=Row()
            cCodigo:=APA01->Codigo
            APC01->(OrdSetFocus(1))
            APC01->(DbSeek(cCodigo))
            IF APC01->Situacao = "A"
               cSituacao:="ATIVO  "
            ELSE
               cSituacao:="       "
            ENDIF
            *
            @ 07, 01 GET APC01->Codigo    PICTURE "@R 99.999"
            @ 07, 12 GET APC01->Nome      PICTURE "@!"
            @ 07, 55 GET APC01->Classe_PG PICTURE "@K 99X"
            @ 07, 65 GET APC01->Categoria PICTURE "X"
            @ 07, 71 GET cSituacao
            CLEAR GETS
            FSom("fsom003.wav")
            SetPos(nRow,nCol)
         ENDIF
         *         
         cObsMemo:=F_LeMemo("APC01", "ARQOBS")
         IF !Empty(cObsMemo)
            ColorWin(23,05,23,08,"W+/R*") 
         ELSE
            ColorWin(23,05,23,08,"W+/B")       
         ENDIF 
         DbSelectArea("APA01")
         nTecla:=Inkey(0)
      ENDIF
      *    
      DO CASE
      CASE ( nTecla == K_F10 ) 
           EVAL(oTBrowse:cargo )
      CASE ( nTecla == K_F11 ) 
           IF !Empty(cObsMemo)
              ColorWin(23,05,23,08,"W+/R*") 
              ObsMemo(09,01,21,MaxCol()-1,.F.)
              ColorWin(23,05,23,08,"W+/B") 
           ENDIF 
      CASE ( nTecla == K_ESC ) 
           EXIT
      CASE ( nTecla == K_ENTER ) .AND. (oTBrowse:colpos = 5 )
           //oTBrowse:refreshall()
      CASE ( nTecla == K_DOWN ) 
           //oTBrowse:down() 
           //IF EOF()
           //   MsgIni('In¡cio de Arquivo','Aten‡Æo',500)
           //ENDIF
      CASE ( nTecla == K_UP ) 
           //oTBrowse:up () 
           //IF BOF()
           //   MsgIni('In¡cio de Arquivo','Aten‡Æo',500)
           //ENDIF
      CASE ( nTecla == K_LEFT ) 
           //oTBrowse:left () 
      CASE ( nTecla == K_RIGHT ) 
           //oTBrowse:right() 
      CASE ( nTecla == K_PGUP ) 
           //oTBrowse:pageup () 
      CASE ( nTecla == K_PGDN ) 
           //oTBrowse:pagedown () 
      CASE ( nTecla == K_CTRL_PGUP ) 
           //oTBrowse:gotop () 
      CASE Upper(Chr(nTecla)) = 'X'
           //cPassWord :=Space(4)
           //cPassWord :=GetSecret( cPassword, 24, 01, .T., "Entre com a senha: ","*")
           IF Confirme('exclusÆo','N')
              //IF GetSenha(24,01,4,'Digite a senha de acesso:',"2006","W+/B*")
              IF Senha(24,01,'Digite a senha de acesso:',"2006","W+/B*")
                 APA01->(DbRLock())
                 APA01->(DbDelete())
                 APA01->(DbCommit())
                 APA01->(DbUnLock())
                 APA01->(DbSkip())
                 oTBrowse:refreshAll()
              ENDIF
           ENDIF
      ENDCASE 
      IF oTBrowse:applyKey( nTecla ) == TBR_EXIT
         ColorWin(23,05,23,08,"W+/B") 
         EXIT
      ENDIF
   ENDDO
RETURN Nil
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