Tenho uma consulta em que quero colocar a linha que tem a primeira coluna "SIM" com a segunda cor de oBrose:colorSpec e não estou sabendo o lugar de colocar a variável colorBlock, ou até de saber se o valor dela está correto.
Código: Selecionar todos
////////////////////////////////////////////////////////////////////////////////
//Fonte: https://vivaclipper.wordpress.com/tag/array-browse/
//Links: https://pctoledo.org/forum/viewtopic.php?f=4&t=9575
#pragma -w0
#pragma -es0
#xtrans :data => :cargo\[1]
#xtrans :recno => :cargo\[2]
#include "GAS.ch"
#include "TBrowse.ch"
#include "inkey.ch"
Function RTP_RetGet(cCodigo, cDia, cMes, cUo, cTipo, cCredor, cNome, cFr, cEstorno)
Local mRetorno := .f., aCab := {}, aDados := {}, aDados2 := {}, mAlias := Alias(), i
Local dele_atu := Set(_SET_DELETED, .T.) //Incluir os Excluidos
If !USEARQ('RET', .f., 10)
Return
EndIf
Set Filter To If(!Empty( cUo), tuo_codigo = cUo, .t.) .and. ret_tipo + ccr_codigo = cTipo + cCredor .and. ;
If(mRtpFR > '000', ret_fr = mRtpFR, .t.) .and. ;
If(cEstorno $ [ N], ret_saldo > 0.00, ret_vlPag > 0.00) .and. ;
ret_aa + ret_mm + ret_dd <= M->par_aa + cMes + cDia .and. Exportado <> 'S'
Go Top
aCab := {;
{'Status' , 03, '@!'},;
{'RET C¢digo' , 06, '999999'},;
{'Conta PCASP', 11, '@R 99999.99.99'},;
{'FR' , 03, '999'},;
{'UO C¢digo' , 08, '@R 99.99.99'},;
{'Ano EMP' , 04, '9999'},;
{'EMP N£mero' , 08, '99999999'},; //05
{'LIQ N£mero' , 08, '99999999'},; //08
{'Data RET' , 10, '@D'},; //09
{'Valor RET' , 13, '@E 9,999,999.99'},; //10
{'Saldo/Pago' , 13, '@E 9,999,999.99'},; //11
{'Tipo' , 02, '99'},;
{'Credor' , 06, '999999'};
}
Do While !Eof()
If cEstorno $ [ N]
mValor := ret_saldo
Else
mValor := ret_vlPag
EndIf
AAdd(aDados, {'NÆo', ret_codigo, pla_codpla, ret_fr, tuo_codigo,;
emp_ano, emp_numero, liq_numero, CtoD( Transform(ret_dd + ret_mm + ret_aa, '@R 99/99/9999') ),;
ret_valor, mValor, ret_tipo, ccr_codigo})
Skip
EndDo
Set(_SET_DELETED, dele_atu)
Set Filter To
Begin Sequence
If Len(aDados) > 0
SetCursor(0)
aDados2 := RTP_RetBRow(16, 1, 38, 130, aCab, aDados, 9, cUo, cTipo, cNome)
SetCursor(1)
For i := 1 To Len(aDados2)
If Upper(aDados2[i, 1]) = 'SIM'
IF !USEARQ('RTLanc', .f., 20, 1)
Break
EndIf
Ptab(cCodigo, 'RTPag', 1)
Ptab(aDados2[i, 2], 'RET', 1)
If i = 1
If RTPag->( DbRLock() )
RTPag->( DbRecall() )
EndIf
RTPag->( DbRUnlock() )
EndIf
DbAppend()
Replace;
rtp_codigo With cCodigo ,;
ret_codigo With aDados2[i, 2] ,;
rtp_DD With cDia ,;
rtp_MM With cMes ,;
tuo_codigo With RET->tuo_codigo ,;
emp_ano With RET->emp_ano ,;
emp_numero With RET->emp_numero ,;
liq_numero With RET->liq_numero ,;
pag_numero With RET->pag_numero ,;
ret_tipo With cTipo ,;
cap_codigo With RET->cap_codigo ,;
pla_codpla With RET->pla_codpla ,;
ret_fr With cFr ,;
ccr_codigo With RET->ccr_codigo ,;
ccr_cpfcnp With RET->ccr_cpfcnp ,;
ret_tabela With RET->ret_tabela ,;
rtl_valor With aDados2[i, 11]
If RTPag->(DbRLock())
Replace RTPag->rtp_vlTot With RTPag->rtp_vlTot + aDados2[i, 11]
EndIf
If RET->(DbRLock())
If cEstorno $ [ N]
Replace;
RET->ret_vlPag With RET->ret_vlPag + aDados2[i, 11]
Else
Replace;
RET->ret_vlPag With RET->ret_vlPag - aDados2[i, 11]
EndIf
Replace;
RET->ret_PagDD With cDia,;
RET->ret_PagMM With cMes,;
RET->ret_PagAA With M->par_aa,;
RET->pgr_codigo With 'RTPag->' + rtp_codigo
Replace RET->ret_saldo With RET->ret_valor - RET->ret_vlPag
If Empty( RET->guid)
RET->guid := NewGuid32()
EndIf
EndIf
EndIf
Next
mRetorno := .t.
Else
msg := 'Não encontrei registros de Retenção a pagar com saldo maior que ZERO e não foram Exportados. Inclua manualmente as Retenções.' + CRLF
msg += 'U.O.: ' + Transform(cUo, '@R 99.99.99') + CRLF
msg += 'Tipo:' + cTipo + CRLF
msg += 'Credor: ' + cCredor
msgAtencao(msg)
mRetorno := .f.
EndIf
End Sequence
Select (mAlias)
Return mRetorno
/////////////////////////////////////////////////////////////////////////////
Static PROCEDURE RTP_RetBRow(nLi, nCi, nLf, nCf, aACab, aADados, nColSoma, cUo, cTipo, cNome)
LOCAL lContinue := .T. ,;
nKeyPressed := 0,;
nArryRowNo := 1,;
i, bBlock, oTBColumn, oCol, xVar
Private mVltotal := 0.00, mVar
* Draw a box around Browse window
If AbreJanela( 'RETENÇÕES A INCLUIR NO PAGAMENTO:', nLi, nCi, nLf, nCf, ) == 0
MsgError( "Erro ao abrir Janela de dados." )
Return
EndIf
* Define a new TBrowse object
oBrowse := TBrowse():New( nLi + 1, nCi, nLf -3, nCf )
aDados := aAdados
oBrowse:cargo := {aDados, 1}
oBrowse:colorspec := drvcorbox + ", " + drvcorhlp + ", " + drvcorenf + ", " + drvcorGet + ", " + INVCOR(drvcorpad)
oBrowse:headsep := chr(205) + chr(203) + chr(205) // separador do cabecalho (Í-Í)
oBrowse:colsep := " " + chr(179) + " " // separador das colunas ( ³ )
oBrowse:footSep := chr(205) + chr(202) + chr(205) // separador do cabecalho (Í-Í)
@ oBrowse:ntop-1, oBrowse:nleft Say 'Filtro: UO[' + Transform(cUo, '@R 99.99.99') +;
'] + Tipo[' + cTipo + '] + Credor[' + Trim(cNome) + ']' + If(mRtpFR > '000', ' + FR[' + mRtpFR + ']', '') Color corcampo
@ oBrowse:nBottom + 3, oBrowse:nleft + 1 Say 'Tecle [Enter] ou [Ctrl+S-Marca tudo] para selecionar e [ESC] para sair.'
oBrowse:goTopBlock := {|| oBrowse:recno := 1 }
oBrowse:goBottomBlock := {|| oBrowse:recno := Len( oBrowse:data ) }
oBrowse:SkipBlock := { | nSkip | ArraySkipper( nSkip, oBrowse ) }
For i := 1 To Len(aAcab)
bBlock := ArrayBlock( oBrowse, i )
oTBColumn := TBColumn():New( aAcab[i, 1], bBlock )
oTBColumn:width := aACab[ i, 2 ]
oTBColumn:picture := aACab[ i, 3 ]
oBrowse:AddColumn( oTBColumn )
oBrowse:getcolumn(i):cargo := 0
Next
For i := 1 TO oBrowse:colcount // atualiza as cores das colunas e muda caso Status sela "SIM"
oBrowse:getcolumn(i):colorblock=&("{||If(BrwStatus(), {2, 2}, 1, 2} ) }")
Next
While lContinue // Browse's loop
IF NextKey() = 0
oBrowse:RefreshCurrent()
While .not. oBrowse:stabilize()
EndDo // Stabilizing loop
oBrowse:ColorRect( { oBrowse:RowPos, oBrowse:LeftVisible, oBrowse:RowPos, oBrowse:RightVisible }, { 5, 5 } ) // linha está com o cursor
oBrowse:ColorRect( { oBrowse:RowPos, oBrowse:ColPos, oBrowse:RowPos, oBrowse:ColPos }, { 2, 2 } ) // linha/coluna está com o cursor
oBrowse:refreshall() // refaz so' a linha do browse
IF ! Empty( oBrowse:Freeze ) // Marcar parte congelada
oBrowse:ColorRect( { oBrowse:RowPos, 1, oBrowse:RowPos, oBrowse:Freeze }, { 5, 5 } )
EndIf
@ oBrowse:nBottom + 1, oBrowse:nleft + 01 Say 'Valor selecionado:'
@ oBrowse:nBottom + 1, oBrowse:nleft + 92 Say Transform(mVlTotal, '@E 99,999,999.99') Color drvCorPad
wvw_DrawFocusRect(, oBrowse:RowPos + nLi + 2, oBrowse:nLeft, oBrowse:RowPos + nLi + 2, oBrowse:nRight ) // linha está com o cursor
EndIf
nKeyPressed := KeyPressed( @oBrowse )
If nKeyPressed == K_CTRL_C
oCol := oBrowse:getColumn( oBrowse:colPos )
mGet := EVal(oCol:block)
WVW_SetClipboard( HB_OemToAnsi( mGet ) )
DBOX("Valor da c‚lula copiado para rea de transferˆncia.|" + '"' + Trim(Left( mGet, 80 )) + '"', , , 3,,,,,,drvcorhlp)
ElseIf nKeyPressed == K_CTRL_O
For i := 1 To Len(aAcab)
oBrowse:getColumn( i ):heading := aAcab[i, 1]
Next
nPos := oBrowse:colPos
oCol := oBrowse:getColumn(nPos)
mValor := EVal(oCol:block)
If oBrowse:getColumn( nPos ):cargo = 0
If Valtype( mValor ) = 'N'
aSort(aDados,,, { |x, y| x[nPos] < y[nPos] } )
Else
aSort(aDados,,, { |x, y| Upper(x[nPos]) < Upper(y[nPos]) } )
Endif
oCol:heading := PadR(aAcab[nPos, 1], aACab[ nPos, 2 ] -2) + ' ' + Chr(26)
oBrowse:getColumn( nPos ):cargo := 1
ElseIf oBrowse:getColumn( nPos ):cargo = 1
If Valtype( mValor ) = 'N'
aSort(aDados,,, { |x, y| x[nPos] > y[nPos] } )
Else
aSort(aDados,,, { |x, y| Upper(x[nPos]) > Upper(y[nPos]) } )
Endif
oCol:heading := PadR(aAcab[nPos, 1], aACab[ nPos, 2 ] -2) + ' ' + Chr(27)
oBrowse:getColumn( nPos ):cargo := 2
ElseIf oBrowse:getColumn( nPos ):cargo = 2
If Valtype( mValor ) = 'N'
aSort(aDados,,, { |x, y| x[nPos] < y[nPos] } )
Else
aSort(aDados,,, { |x, y| Upper(x[nPos]) < Upper(y[nPos]) } )
Endif
oCol:heading := PadR(aAcab[nPos, 1], aACab[ nPos, 2 ] -2) + ' ' + Chr(26)
oBrowse:getColumn( nPos ):cargo := 1
Endif
oBrowse:configure() // tempo de "refresh" entao
Endif
lContinue := TBrApplyKey( oBrowse, nKeyPressed )
IF nKeyPressed = 0 // nao teclou nada, sai pelo
oBrowse:refreshall() // tempo de "refresh" entao
LOOP // na tela e volta
EndIf
EndDo
SetPos( 23, 0 )
FechaJanela()
RETURN aDados
Function BrwStatus()
Local r := .f., oCol
oCol := oBrowse:getColumn(1)
mVar := EVal(oCol:block)
If mVar = 'SIM'
r:= .t.
Endif
Return r
// This code block uses detached LOCAL variables to
// access single elements of a two-dimensional array.
FUNCTION ArrayBlock( oTBrowse, nSubScript )
RETURN {|| oTBrowse:data[ oTBrowse:recno, nSubScript ] }
// This function navigates the row pointer of the
// the data source (array)
FUNCTION ArraySkipper( nSkipRequest, oTBrowse )
LOCAL nSkipped
LOCAL nLastRec := Len( oTBrowse:data ) // Length of array
IF oTBrowse:recno + nSkipRequest < 1
// skip requested that navigates past first array element
nSkipped := 1 - oTBrowse:recno
ElseIF oTBrowse:recno + nSkipRequest > nLastRec
// skip requested that navigates past last array element
nSkipped := nLastRec - oTBrowse:recno
Else
// skip requested that navigates within array
nSkipped := nSkipRequest
EndIf
// adjust row pointer
oTBrowse:recno += nSkipped
// tell TBrowse how many rows are actually skipped.
RETURN nSkipped
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
/*
Handle the (some) keystrokes of user
*/
FUNCTION TBrApplyKey( oBrowse, nKey )
LOCAL lRVal := .T., i
Private mVar
DO CASE
CASE nKey == K_SPACE .or. nKey == K_ENTER
oCol := oBrowse:getColumn(1)
mVar := EVal(oCol:block)
If Left(mVar, 1) = 'N'
oCol := oBrowse:getColumn(11)
mVlTotal += EVal(oCol:block)
aDados[oBrowse:recno, 1] := 'Sim'
Else
oCol := oBrowse:getColumn(11)
mVlTotal -= EVal(oCol:block)
aDados[oBrowse:recno, 1] := 'NÆo'
EndIf
oBrowse:refreshall() // refaz so' a linha do browse
///oBrowse:refreshcurrent() // refaz so' a linha do browse
CASE nKey == K_CTRL_S
For i := 1 TO Len(aDados)
aDados[i, 1] := 'Sim'
Next
oBrowse:refreshall() // refaz so' a linha do browse
CASE nKey == K_CTRL_N
For i := 1 TO Len(aDados)
aDados[i, 1] := 'NÆo'
Next
oBrowse:refreshall() // refaz so' a linha do browse
CASE nKey == K_UP
oBrowse:Up()
CASE nKey == K_LEFT
oBrowse:Left()
CASE nKey == K_RIGHT
oBrowse:Right()
CASE nKey == K_DOWN
oBrowse:down()
CASE nKey == K_HOME
oBrowse:home()
CASE nKey == K_END
oBrowse:end()
CASE nKey == K_PGUP
oBrowse:pageUp()
CASE nKey == K_PGDN
oBrowse:pageDown()
CASE nKey == K_CTRL_PGDN
oBrowse:goBottom()
CASE nKey == K_CTRL_PGUP
oBrowse:goTop()
CASE nKey == K_ESC
// End of Browse and program
lRVal := .F.
ENDCASE
RETURN lRVal // TBrApplyKey()
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
