cor no tbrowse

cjp · Mensagem por **cjp** » 15 Ago 2021 22:33

O que eu disse que não está funcionando é só mesmo a questão da cor. O resto da função funciona normalmente.

Vou postar o código completo, tirando apenas o que não interessa para esta questão. Já adianto que esta função está mesmo um frankstein, porque, por enquanto, é a única forma que eu consegui fazer funcionar um tbrowse aqui.

Código: Selecionar todos

function consado(sql,or,modo,coluna,prov)
         #include "tbrowse.ch"
		 local cSair :="N"
         LOCAL oColumn, I, nLen, oTBrowse, oRs, cod, prd, prmax
		 local vez2 :=0
		 local vez :=0
		 local vl :=0
		 local merc :=space(15)
		 local nProvAqui :=nProvTar
         local rw :=row()
		 local cl :=col()
	     local nCursor :=setCursor(0)
		 private conexao
		 private dt :=date() 
		 private nKey :=99999 
		 
	         vl=0
			 merc=space(15)
			 dt=date()

		 cls
	        @ 12,15 say "Abrindo consulta"
		 
		 if prov>0
		    nProvAqui=prov
		 elseif "FROM ATIV"$upper(sql)
		    nProvAqui=nProvAtiv
		 elseif "FROM COMPRAS"$upper(sql)
		    nProvAqui=nProvCompras
		 elseif "FROM TARPRINC"$upper(sql)
		    nProvAqui=nProvTarPrinc
		 endif
		 
		 if us#"I" .and. (procname(1)="ENTERITEM" .or. procname(2)="ENTERITEM")
		    keysec(-18,115,-1,.t.)
		 else
		    keysec(27,1500,-1,.t.)
		 endif
		 
		 @ 12,15 say "Conectando        "
		 
		 do while .t.
		    if !AdoConecta(nProvAqui,7)
		       @ 12,15 say "Não conseguiu conectar; tente novamente mais tarde"
			   inkey(5)
			   return .f.
	        else
			   @ 12,15 say "Executando a consulta"
		       if "FROM ATIV"$upper(sql)
                  oRs := Conexao:Execute("SET MAX_JOIN_SIZE=1111111111111")
			   endif
               oRS := Conexao:Execute( sql )
		    endif
	  
            if oRS:Eof()
	           @ 12,15 say "Não há nenhum item      "
		       inkey(11)
		       inkey(11)
	           return .f.
	        endif

            cls
        oTBrowse := TBrowseDB():new( 7, 2, MaxRow() - 5, maxcol()-1 )
         // Colors
         oTbrowse:colorSpec := "N/W, W+/N,N/W*,W+/R,R/W,R/W*"

	  if procname(1)="CONSPROD2" .or. procname(2)="CONSPROD2"
         oTBrowse := TBrowseDB():new( 2, 3, MaxRow() - 4, 79 )
		 @ maxrow()-2,5 say "Total: "+alltrim(str(nTot))
		 inkey(0.7)
      elseif procname(1)="ENTERITEM" .or. procname(2)="ENTERITEM"
...

	  elseif procname(2)="CONSATIV" .and. ophrtar=5 .and. or="S"
             oTBrowse := TBrowseDB():new( 03, 3, MaxRow() - 5, 30 )
	  elseif procname(2)="CONSATIV"
             oTBrowse := TBrowseDB():new( 02, 1, MaxRow() - 5, maxcol() )
	  elseif procname(1)="BROWSECOMPRAS"
             oTBrowse := TBrowseDB():new( 01, 1, MaxRow() - 4, maxcol() )
...
	  elseif procname(1)="ADOTARPRINC"
             oTBrowse := TBrowseDB():new( 03, 3, MaxRow() - 4, 75 )
...
	  else
         oTBrowse := TBrowseDB():new( 06, 3, MaxRow() - 7, MaxCol() - 2 )
	     @ maxcol()-1,5 say "[ESC] - sai; [ENTER] - abre a atividade"
	  endif

      oTBrowse:goTopBlock    := { || oRs:moveFirst() }
      oTBrowse:goBottomBlock := { || oRs:moveLast() }
      oTBrowse:skipBlock     := { | n | ADORecordSetSkipper( oRs, n ) }
      oTBrowse:HeadSep       := Chr(196)
      oTBrowse:ColSep        := Chr(179)
      oTBrowse:FootSep       := ""
	  
      nLen := oRs:fields():count() - 1
	  
	  
      IF us="I" .and. procname(2)="ENTERITEM"
...
	  Else
         FOR i := 0 TO nLen
                oColumn       := TBColumnNew( oRs:fields(i):name(), ADORecordSetFieldBlock( oRs, i ) )
		 
		     IF ValType( oRs:Fields(i):Value ) == "D"
                nFieldLen := Len( Dtoc( Date() ) )
...
             ELSE
                nFieldLen := Min( oRs:Fields(I):DefinedSize, 30 )
             ENDIF
		 
			 
	         If procname(1)="CONSPONTO"
		        IF upper(oRs:fields(i):name)="COMIDA"
		           nFieldLen := 47
		        ELSEIF upper(oRs:fields(i):name)="QUANTIDADE"
		           nFieldLen := 18
		        ELSEIF upper(oRs:fields(i):name)="PONTOS"
		           nFieldLen := 12
		        ELSEIF upper(oRs:fields(i):name)="ID"
		           nFieldLen := 9
				Endif
			 Endif
			 
			 
             IF (procname(2)="ENTERITEM" .or. procname(3)="ENTERITEM" .or. procname(4)="ENTERITEM" .or. procname(5)="ENTERITEM" .or. procname(6)="ENTERITEM" .or. procname(7)="ENTERITEM" .or. procname(8)="ENTERITEM" .or. procname(9)="ENTERITEM" .or. procname(10)="ENTERITEM")
                oColumn:Width := nFieldLen
			 Else
                oColumn:Width := Max( nFieldLen, Len( oRs:fields(i):name ) )
		     Endif
		 
	         If "FROM CIENCIA"$upper(sql)
                oTBrowse:addColumn( oColumn )
			 Else
                oTBrowse:addColumn( oColumn )
			 Endif
		 
         NEXT
	  
	  Endif

   DO WHILE .T.
      vez++
	  
	  If "FROM PONTOS"$upper(sql)
            oTBrowse:forceStable()

            // Paint TBrowse current line...
            oTBrowse:ColorRect( { oTBrowse:RowPos, oTBrowse:LeftVisible, oTBrowse:RowPos, oTBrowse:RightVisible }, { 2, 1 } )
            // ... and current cell in different colors
            If oTBrowse:colPos == 3 .And. At( "TOTAL ", Upper( Eval( oTBrowse:getColumn( 3 ):block ) ) ) > 0 
               oTBrowse:ColorRect( { oTBrowse:rowPos, oTBrowse:colPos, oTBrowse:rowPos, oTBrowse:colPos }, { 6, 6 } )
            Else
               oTBrowse:ColorRect( { oTBrowse:rowPos, oTBrowse:colPos, oTBrowse:rowPos, oTBrowse:colPos }, { 3, 2 } )
            Endif
	  Else
      oTBrowse:forceStable()
      oTBrowse:refreshCurrent()
	  Endif


	  
	  
	  set cursor on
	  
	  IF (vez=1 .or. (us="I" .and. vez/20=int(vez/20)) .or. (us#"I" .and. vez/5=int(vez/5)))
	     if procname(2)="ENTERITEM" .and. (procname(3)#"CONSPROX" .or. procname(4)#"CONSPROX" .or. procname(5)#"CONSPROX" .or. procname(6)#"CONSPROX" .or. procname(7)#"CONSPROX" .or. procname(8)#"CONSPROX" .or. procname(9)#"CONSPROX" .or. us="I")
...
	     elseif "FROM CIENCIA"$upper(sql)
...
	     elseif "CONSPONT"$procname(1)
		     @ maxrow()-1,1 say "[ENTER] - atribui pontos; A - altera data e hora; C - copiar (duplicar) registro; E - exclui; Q - altera quantidade; M - muda comida"
	     elseif procname(1)="CONSCOT"
...
	     elseif procname(1)="CONSRECADO"
...
	     elseif procname(1)="BROWSECOMPRAS"
...
	     endif
		 
	  Endif

      nKey := Inkey(0)

	  set cursor on
	  
	  IF procname(1)="BROWSECOMPRAS"
	     cod=oRs:Fields("codprod"):Value
	  ELSEIF procname(1)="ADOTARPRINC" .or. "CONSPONTO"$procname(1)
	     cod=oRs:Fields("id"):Value
	  Endif

	  if nkey ==13 .and. procname(2)="CONSATIV" .and. ophrtar=5 .and. or="S"
	     ac1=oRs:Fields("acao"):Value
		 cSair="S"
		 exit
		 
	  elseif nkey ==7 .and. procname(1)="CONSRECADO"
...		
	  elseif nkey ==13 .and. (procname(1)="CONSCOT" .or. procname(1)="ACOESBMF")
...		
	  elseif upper(chr(nkey))=="T" .and. (procname(1)="CONSCOT" .or. procname(1)="ACOESBMF")
...	  
	  elseif nkey ==13 .and. procname(1)="CONSRECADO"
...
	  elseif "FROM CIENCIA"$upper(sql) .and. (upper(chr(nkey))=="S" .or. upper(chr(nkey))=="O")
...	  
	  elseif "FROM CIENCIA"$upper(sql) .and. nkey ==13
...
	  elseif upper(chr(nkey))=="C" .and. (procname(1)="EDPRIOR" .or. procname(2)="EDPRIOR")
...		
      elseif nkey==13 .and. (procname(1)="EDPRIOR" .or. procname(2)="EDPRIOR") .and. oTbrowse:colPos()=2 .and. oRs:Fields("hrfim"):Value="----"
...		 
      elseif (nkey==13 .or. (nkey>=48 .and. nkey<58) .or. chr(nkey)=="-") .and. (procname(1)="EDPRIOR" .or. procname(2)="EDPRIOR")
...			
	  elseif (nkey==65 .or. nkey==97 .or. nkey==13) .and. "DESPCARTAO"$procname(1)
...				 
	  elseif upper(chr(nkey)) =="D" .and. "DESPCARTAO"$procname(1)
...	  
	  elseif nkey ==13 .and. "CONSPONTO"$procname(1)
	         nPt=0
	         @ maxrow()-10,35 say "Pontos:"get nPt pict "999.99"
			 read 
			 if lastkey()#27
			    exqado("update pontos set pontos="+alltrim(str(nPt))+" where id="+alltrim(str(cod)))
			 endif
			 @ maxrow()-10,35 clear to maxrow()-10,77
			 
	  elseif upper(chr(nkey)) =="C" .and. "CONSPONTO"$procname(1)
	         dDt=date()  //oRs:Fields("data"):Value
	         cHr=time()  //oRs:Fields("hora"):Value
	         cCom=oRs:Fields("comida"):Value
	         cQuant=oRs:Fields("quantidade"):Value
	         nPt=oRs:Fields("pontos"):Value
			 
			 @ maxrow()-5,25 say "Nova data:"get dDt
             @ maxrow()-4,25 say "Nova hora:"get cHr pict "99:99:99"
			 read
			 if lastkey()#27
				exqado("insert into pontos (data,hora,comida,quantidade,pontos) values ('"+dtsql(dDt)+"','"+cHr+"','"+cCom+"','"+cQuant+"',"+alltrim(str(nPt))+")")
			 endif
			 @ maxrow()-5,25 clear to maxrow()-4,77
			 
	  elseif upper(chr(nkey)) =="A" .and. "CONSPONTO"$procname(1)
	         dDt=oRs:Fields("data"):Value
	         cHr=oRs:Fields("hora"):Value
	         @ maxrow()-5,25 say "Nova data:"get dDt
			 @ maxrow()-3,25 say "Nova hora:"get cHr
			 read 
			 if lastkey()#27
			    exqado("update pontos set data='"+dtsql(dDt)+"',hora='"+cHr+"' where id="+alltrim(str(cod)),3)
			 endif
			 @ maxrow()-5,25 clear to maxrow()-3,77
			 
	  elseif upper(chr(nkey)) =="Q" .and. "CONSPONTO"$procname(1)
	         cQuant=oRs:Fields("quantidade"):Value+space(15)
	         @ maxrow()-5,25 say "Nova quantidade:"get cQuant
			 read 
			 if lastkey()#27
			    exqado("update pontos set quantidade='"+alltrim(cQuant)+"' where id="+alltrim(str(cod)),3)
			 endif
			 
	  elseif upper(chr(nkey)) =="M" .and. "CONSPONTO"$procname(1)
	         cCom=oRs:Fields("comida"):Value+space(15)
	         @ maxrow()-5,25 say "Comida:"get cCom
			 read 
			 if lastkey()#27
			    exqado("update pontos set comida='"+alltrim(cCom)+"' where id="+alltrim(str(cod)),3)
			 endif
			 
	  elseif upper(chr(nkey)) =="E" .and. "CONSPONTO"$procname(1)
	         conf="N"
	         @ maxrow()-5,25 say "Confirma exclusão?"get conf pict "@!"
			 read 
			 if conf="S"
			    if exqado("delete from pontos where id="+alltrim(str(cod)),3)
				   @ maxrow()-1,5 say "Excluído com sucesso"
				   inkey(3)
				endif
			 endif
			 
	  elseif upper(chr(nkey)) =="E" .and. "DESPCARTAO"$procname(1)
...	  
	  elseif upper(chr(nkey)) =="V" .and. procname(1)="BROWSECOMPRAS"
...	  
	  elseif upper(chr(nkey)) =="Q" .and. procname(1)="BROWSECOMPRAS"
...			 
	  elseif upper(chr(nkey)) =="U" .and. procname(1)="BROWSECOMPRAS"
    ...			 
	  elseif upper(chr(nkey)) =="C" .and. procname(1)="BROWSECOMPRAS"
...			 
	  elseif upper(chr(nkey)) =="M" .and. procname(1)="BROWSECOMPRAS"
...
	  
	  elseif upper(chr(nkey)) =="O" .and. procname(1)="BROWSECOMPRAS"
...	  
	  elseif upper(chr(nkey)) =="T" .and. procname(1)="BROWSECOMPRAS"
...	  
	  elseif upper(chr(nkey)) =="I" .and. procname(1)="BROWSECOMPRAS"
...	  
	  elseif nkey ==13 .and. procname(1)="BROWSECOMPRAS"
...	         
	  elseif (nkey ==13 .or. upper(chr(nkey)) =="*") .and. procname(1)="ADOTARPRINC"
...	  
	  elseif upper(chr(nkey)) =="-" .and. procname(1)="ADOTARPRINC"
...	  
	  elseif upper(chr(nkey)) =="M" .and. (procname(2)="CONSATIV" .or. procname(1)="CONSACAO" .or. procname(1)="NOVACONSACAO")
...		 
	  elseif nkey == 13 .and. (procname(1)="CONSACAO" .or. procname(1)="NOVACONSACAO") //K_ENTER
    ...	  
	  elseif nkey == 13 .and. procname(1)#"ENTERITEM" .and. procname(2)#"ENTERITEM" .and. procname(3)#"ENTERITEM"   //K_ENTER
...		 
	  elseif (upper(chr(nkey)) =="R" .or. ((us="U" .or. us="I") .and. nkey==275)) .and. (procname(1)="ENTERITEM" .or. procname(2)="ENTERITEM")
...	  
	  endif
	  
      IF oTBrowse:applyKey( nKey ) == TBR_EXIT
	     cSair="S"
         EXIT
      ENDIF
   ENDDO
   
   
   if cSair="S"
      exit
   endif
   enddo

   oRs:Close()
   Conexao:Close()
   if cSair="S" .and. procname(1)#"CONSEXPR" .and. procname(2)#"CONSEXPR"
      return .f.
   endif
return .t.

FUNCTION ADORecordSetFieldBlock( oRs, i, xVal )

   LOCAL bRet

   IF xVal == NIL
      IF oRs:eof()
         bRet := { || Space( Max( oRs:Fields( i ):DefinedSize , Len( oRs:Fields( i ):name ) ) ) }
      ELSE
         bRet := { || oRs:Fields( i ):value }
      ENDIF
   ELSE
      bRet := { |xVal| oRs:Fields( i ):Value := xVal }
   ENDIF

   RETURN bRet

FUNCTION ADORecordSetSkipper(oRecordSet,nSkip)

   LOCAL nRec := oRecordSet:AbsolutePosition

   IF ! ( oRecordSet:eof )
      oRecordSet:Move( nSkip )
      IF oRecordSet:eof
         oRecordSet:moveLast()
      ENDIF
      IF oRecordSet:bof
         oRecordSet:moveFirst()
      ENDIF
   ENDIF

RETURN (oRecordSet:AbsolutePosition - nRec)

Mensagem por **alxsts** » 15 Ago 2021 22:35

Olá!

Não. ColorRect() configura o retângulo. Para pintar tem que fazer um refreshAll ou refreshCurrent. Como é apenas a linha corrente, o indicado é o refreshCurrent. Para tirar a dúvida, é simples. Pega o meu exemplo, comente a linha do refreshCurrent, compile, crie as tabelas e execute. Veja o que acontece.

Mensagem por **JoséQuintas** » 16 Ago 2021 00:17

alxsts escreveu:Não. ColorRect() configura o retângulo. Para pintar tem que fazer um refreshAll ou refreshCurrent

Não.
Refresh atualiza pintado.
ColorRect() altera a cor.
Meu browse é assim há anos, de DBF e de ADO.

Mensagem por **JoséQuintas** » 16 Ago 2021 00:33

ColorRect() é pra exceções, que no meu caso é sempre.

Código: Selecionar todos

   DO WHILE .T.
      oBrowse:RefreshCurrent()
      nkey := 0
      DO WHILE ! oBrowse:Stable // // Problemas ao acelerar dbview
         oBrowse:Stabilize()
         //   nkey := Inkey()
      ENDDO
      IF oBrowse:Stable
         oBrowse:ColorRect( { oBrowse:RowPos, 1, oBrowse:RowPos, oBrowse:ColCount }, { 3, 3 } ) // linha está com o cursor
         oBrowse:ColorRect( { oBrowse:RowPos, oBrowse:ColPos, oBrowse:RowPos, oBrowse:ColPos }, { 2, 2 } ) // linha/coluna está com cursor
         cTimeLimit := TimeAdd( Time(), "M", 10 )
         nkey := Inkey( INKEY_IDLE, HB_INKEY_ALL - INKEY_MOVE + HB_INKEY_GTEVENT )
         IF nKey == 0 .AND. Time() > cTimeLimit
            KEYBOARD Chr( K_ESC )
            LOOP
         ENDIF
      ENDIF

Mensagem por **JoséQuintas** » 16 Ago 2021 00:38

browse do harbour src/rtl/browse.prg

ColorRect() vém depois do RefreshCurrent()

Mensagem por **alxsts** » 16 Ago 2021 00:40

Olá!

Tá bom Zé... deixa pra lá. Compile o exemplo e veja o que acontece. O caso dele é uma exceção, pra usar a tua terminologia. Só quando a palavra "Total" estiver contida na célula.

Mensagem por **JoséQuintas** » 16 Ago 2021 04:55

https://www.itlnet.net/programming/prog ... 5fa29.html

colorRect(<aRect>, <aColors>) --> self

Directly alters the color of a rectangular group of cells. <aRect>
is an array of four numbers (top, left, bottom, and right). The
numbers refer to cells within the data area of the browse display,
not to screen coordinates. <aColors> is an array of two numbers.
The numbers are used as indexes into the color table for the browse.
These colors will become the normal and highlighted colors for the
cells within the specified rectangle.

Cells that are colored using colorRect retain their color until they
are scrolled off the screen up or down. Horizontal panning has no
affect on these colors and, in fact, cells that are currently off
screen left or right can be colored even if they are not visible.

This example colors the entire virtual window (on and off screen):

aRect := {1, 1, browse:rowCount, browse:colCount}
browse:colorRect(aRect, {2, 1})

ColorRect() altera diretamente as cores, e as cores são mantidas até que as células se movam pra cima ou pra baixo.

Segundo o manual, ColorRect() altera a cor sim, e refreshcurrent() vai manter
Nós dois estamos certos e errados ao mesmo tempo, quanto ao funcionamento.

O único detalhe é que nossos browses tem uma grande diferença: o meu tá otimizado, e só atualiza a tela se estiver parado.
uso refreshcurrent não para a linha atual, mas para a anterior.
Se, por exemplo, o usuário pressionar pgup várias vezes seguidas, não perde tempo atualizando a tela, e por isso a current pode estar com conteúdo errado.
No seu, obrigatoriamente atualiza com ForceStable(), então nem precisa do refreshcurrent.
Sorte que é ADO e não DBF, senão poderia ficar muito lento por causa disso.

Código: Selecionar todos

      DO WHILE nKey == 0 .AND. ! oBrowse:Stable
         oBrowse:Stabilize()
         nKey := Inkey()
      ENDDO
      oBrowse:RefreshCurrent()
      Atail( AppForms() ):UpdateScroll( cnSQL:RecordCount(), cnSQL:AbsolutePosition() )
      IF nKey == 0

Repare que só atualizo a tela se nkey=0, se o browse está "parado", sem usuário apertar nada.
Usando tela 40 X 132, isso faz muita diferença de velocidade.
E se for DBF com SET FILTER então.... vixe...

Mensagem por **alxsts** » 16 Ago 2021 09:17

Olá!

JoséQuintas escreveu:No seu, obrigatoriamente atualiza com ForceStable(), então nem precisa do refreshcurrent.

Repetindo: pegue o meu exemplo, comente a linha onde tem refreshCurrent, altere a string de conerxão, crie a tabela no teu banco e execute. Vai ver se precisa ou não...

Mensagem por **JoséQuintas** » 16 Ago 2021 10:43

Sabia que isso ia dar trabalho.

A linha 144 é da própria mensagem de erro.

Mensagem por **JoséQuintas** » 16 Ago 2021 10:49

Ok, aduseclient coloquei de cabeça, e deveria ser 3.
agora testando

Mensagem por **alxsts** » 16 Ago 2021 11:00

Olá!

Nunca vi isto. Comigo e com o Inácio não acontece este erro. Provavelmente é algo nas propriedades da conexão que você criou. Quanto à linha do erro, preciso ajustar.

Mensagem por **JoséQuintas** » 16 Ago 2021 11:05

Já mostrei no post anterior sobre o erro. traduzi aduseclient como 1 e deveria ser 3.

Agora teste alterado, sem o refreshcurrent() após ColorRect() e veja que também funciona

ForceStable() não atualiza nada, apenas deixa marcado pra ser atualizado depois, por isso é obrigado a usar refreshcurrent()

E neste exemplo, refreshCurrent() é usado pra atualizar a posição anterior, e :Stabilize() realmente atualiza tela.
Por isso não precisa o refreshCurrent() depois.

Só compilar

Da mesma forma, se retirar o refreshcurrent vai ter problema... mas não precisou dele APÓS o ColorRect()

Tá explicado porque muita confusão nisso, depende da lógica da rotina.

Mensagem por **JoséQuintas** » 16 Ago 2021 11:13

Exclui o fonte anterior.
Fiz uma alteração: APAGUEI O COLORRECT()
Teste agora, e veja que não precisa mais do ColorRect() ref totais durante o browse.

test.prg: (7.1 KiB) Baixado 246 vezes

Agora sim, a rotina ficou genérica, sem nenhum tipo de exceção.

Mensagem por **alxsts** » 16 Ago 2021 11:32

Olá!

A pintura das células deixou de funcionar quando do movimento com seta à direita ou esquerda.

Mensagem por **alxsts** » 16 Ago 2021 13:41

Olá!

Voltando o trecho abaixo, volta a funcionar...

Código: Selecionar todos

            // ... and current cell in different colors
            If oTbr:colPos == 3 .And. At( "TOTAL ", Upper( Eval( oTBr:getColumn( 3 ):block ) ) ) > 0
               oTbr:ColorRect( { oTbr:rowPos, oTbr:colPos, oTbr:rowPos, oTbr:colPos }, { 6, 6 } )
            Else
               oTbr:ColorRect( { oTbr:rowPos, oTbr:colPos, oTbr:rowPos, oTbr:colPos }, { 3, 2 } )
            Endif

Ou seja, neste caso, não pode ser genérico.