Page 1 of 1
xBrowse code block to evaluate fieldname()->value
Posted: Sat Jul 10, 2010 10:00 pm
by Rick Lipkin
To All
I have an xbrowse reservation listbox that I want to know if there is a codeblock to evaluate the data contents of each cell in a row and set a cell color for the same data for columns that contain the same value ..
See listbox .. I want to color each like cell the same BACKGROUND ( not forground is in the example ) color as in
LIPKIN LIPKIN LIPKIN JONES JONESSMITH WILSON WILSON
I need to test for the contents of each cell and match it to the next cell (in a loop perhaps ) and color each cell that has the same value .. and I have no way of knowing what the value of each cell is .. I have to mine the cell and test the next cell for the same value .. and move row to row ..
Thanks
Rick Lipkin
Re: xBrowse code block to evaluate fieldname()->value
Posted: Sun Jul 11, 2010 1:32 am
by James Bott
Rick,
Perhaps you can use this code sample for a starting point.
James
Code: Select all | Expand
FOR I = 1 TO LEN(oBrw:aCols)
oBrw:aCols[I]:nWidth := ASIZE[I]
oBrw:aCols[I]:oDataFont := {||IIF(DET->SDETAIL,TABCOL[12],IIF(DET->ENR = "3" .OR. DET->ENR = "1" ,TABOBJ[04], TABCOL[11] ) ) }
oBrw:aCols[I]:bClrStd := {|| {CLR_BLUE, If( DET->SDETAIL,CLR_YELLOW,CLR_WHITE) } }
NEXT
Re: xBrowse code block to evaluate fieldname()->value
Posted: Sun Jul 11, 2010 7:13 am
by nageswaragunupudi
Mr. Rick
Please see this sample
Code: Select all | Expand
#include 'fivewin.ch'
#include 'xbrowse.ch'
function Main()
local oWnd, oBrw, oFont
local aData := { ;
{ 'A', 'B', 'C', 'C', 'C', 'D', 'E' }, ;
{ 'B', 'D', 'D', 'A', 'G', 'G', 'G' }, ;
{ 'P', 'A', 'B', 'A', 'D', 'A', 'A' } }
DEFINE FONT oFont NAME 'TAHOMA' SIZE 0,-20 BOLD
DEFINE WINDOW oWnd
@ 0,0 XBROWSE oBrw OF oWnd AUTOCOLS ARRAY aData ;
CELL LINES FASTEDIT FONT oFont
AEval( oBrw:aCols, { |o| o:nEditType := EDIT_GET, ;
o:nWidth := 60, ;
o:nDataStrAlign := AL_CENTER, ;
SetClrBlock( o ) } )
oBrw:CreateFromCode()
oWnd:oClient := oBrw
ACTIVATE WINDOW oWnd
RELEASE FONT oFont
return nil
static function SetClrBlock( oCol )
oCol:bClrStd := { || If( SameAsNext( oCol ), { CLR_WHITE, CLR_HRED }, { CLR_BLACK, CLR_WHITE } ) }
return nil
static function SameAsNext( oCol )
local lSame := .f.
local nCol := oCol:nCreationOrder
local oBrw := oCol:oBrw
if nCol < Len( oBrw:aCols ) .and. oCol:Value == oBrw:aCols[ nCol + 1 ]:Value
lSame := .t.
endif
if ! lSame .and. nCol > 1 .and. oCol:Value == oBrw:aCols[ nCol - 1 ]:Value
lSame := .t.
endif
return lSame
This browse is set in fast edit mode. Try modifying the values of each cell and see the results. Keep your CAPS lock on.
Re: xBrowse code block to evaluate fieldname()->value
Posted: Sun Jul 11, 2010 1:11 pm
by Rick Lipkin
Rao and James
Thank you for your quick responce !! I will take a look shortly ..
Rick
Re: xBrowse code block to evaluate fieldname()->value
Posted: Sun Jul 11, 2010 1:36 pm
by Rick Lipkin
Rao
Looked and compiled your code .. looks like I will need to determine the color start and end for an exact name then for the next block of names .. determine the next color string and so on .. that is why I was trying to extract the value of the cell so I can compare it .. This will definitly get me started
Code: Select all | Expand
if nCol < Len( oBrw:aCols ) .and. oCol:Value == oBrw:aCols[ nCol + 1 ]:Value
lSame := .t.
endif
if ! lSame .and. nCol > 1 .and. oCol:Value == oBrw:aCols[ nCol - 1 ]:Value
lSame := .t.
endif
Thanks
Rick
Re: xBrowse code block to evaluate fieldname()->value
Posted: Sun Jul 11, 2010 2:28 pm
by nageswaragunupudi
You want to have different colors for different names. Something like this?
Code: Select all | Expand
static function SetClrBlock( oCol )
oCol:bClrStd := { || If( SameAsNext( oCol ), ColorOf( oCol:Value ), { CLR_BLACK, CLR_WHITE } ) }
return nil
static function SameAsNext( oCol )
local lSame := .f.
local nCol := oCol:nCreationOrder
local oBrw := oCol:oBrw
if nCol < Len( oBrw:aCols ) .and. oCol:Value == oBrw:aCols[ nCol + 1 ]:Value
lSame := .t.
endif
if ! lSame .and. nCol > 1 .and. oCol:Value == oBrw:aCols[ nCol - 1 ]:Value
lSame := .t.
endif
return lSame
static function ColorOf( cName )
static hColors := {=>}
// any logic that assigns a different color to different values
if ! HHasKey( hColors, cName )
hColors[ cName ] := nRGB( HB_RandomInt( 0, 220 ), ;
HB_RandomInt( 0, 220 ), ;
HB_RandomInt( 0, 220 ) )
endif
return { CLR_WHITE, hColors[ cName ] }
Re: xBrowse code block to evaluate fieldname()->value
Posted: Sun Jul 11, 2010 5:37 pm
by Rick Lipkin
Rao
You are on the right track .. I want to color each cell individually if no next cell has the same value .. or a string of values if they are all the same leaving the NULL or EMPTY cells the default colors..
A A A B C C D A A A B B
Rick
Re: xBrowse code block to evaluate fieldname()->value
Posted: Mon Jul 12, 2010 5:50 pm
by Rick Lipkin
Rao
Here is pretty much the final code based on your contribution and logic
Code: Select all | Expand
SELECT 1
SET ORDER to TAG VNUMBER
GO TOP
xALIAS := ALIAS()
cMOTORPOOL := xPOOL
xMOTOR := "Agency "+alltrim(xAGENCY)+" for Motorpool "+alltrim( xPOOL )
DEFINE WINDOW oWNDCHILD MDICHILD ;
FROM 1,1 to 33,100 ;
of oWNDMDI ;
NOSYSMENU ;
NOZOOM ;
NOMINIMIZE ;
TITLE "Reservation Information"
DEFINE DIALOG oEMP RESOURCE "RESBROW" of oWNDCHILD
REDEFINE XBROWSE oBrow ID 111 OF oEMP ALIAS xAlias ;
AUTOSORT AUTOCOLS LINES CELL
oBrow:nRowHeight := 15
oBrow:bLDblClick := { |nRow,nCol | oBtn1:Hide(),;
oBtn2:Hide(), ;
oBtn3:Hide(), ;
oBtn4:Hide(), ;
oBtn5:Hide(), ;
_PtrpBrow( CTOD("00/00/00"), A->VNUMBER, oRsPtrips, oRstrips ),;
_ReFrsh( A->VNUMBER, dDATE1 ), ;
oBtn1:Show(), ;
oBtn2:Show(), ;
oBtn3:Show(), ;
oBtn4:Show(), ;
oBtn5:Show(), ;
oBROW:REFRESH(), SysReFresh(),;
oBROW:SetFocus() }
oBROW:nFREEZE := 5
AEval( oBrow:aCols, { |o| o:nDataStrAlign := SetClrBlock( o ) } )
REDEFINE SAY oMOTORPOOL var cMOTORPOOL ID 114 of oEMP
REDEFINE SAY oMOTOR var xMOTOR ID 113 of oEMP
REDEFINE SAY oDATE1 var dDATE1 ID 119 of oEMP
REDEFINE SAY oDATE2 var dDATE2 ID 120 of oEMP
REDEFINE BUTTON oBTN3 ID 115 of oEMP ; // quit
ACTION ( oWndChild:End() )
ACTIVATE DIALOG oEMP NOWAIT ;
ON PAINT GradientFill( hDC, 0, 0, oEMP:nHeight, oEMP:nWidth, xGrad1, .T. ) ;
ON INIT ( oEMP:Move( 0, 0 ), XbrGoToCol( oBrow, nCol),oBrow:SetFocus(),;
IF( (xSUPER = 'Y'.or. xMGR = 'Y' .or. xADMIN = 'Y'), ,oBTN4:HIDE() ))
ACTIVATE WINDOW oWNDCHILD ;
ON INIT ( oWndChild:SetSize( oEMP:nWIDTH,oEMP:nHEIGHT, .T. )) ;
VALID ( IIF( !lOK, CloseRes(.T., oBar1),.F. ))
RETURN( NIL )
//------------------------
static function SetClrBlock( oCol )
* oCol:bClrStd := { || If( SameAsNext( oCol ), { CLR_WHITE, CLR_HRED }, { CLR_BLACK, CLR_WHITE } ) }
oCol:bClrStd := { || If( SameAsNext( oCol ), ColorOf( oCol:Value ), { CLR_BLACK, CLR_WHITE } ) }
return nil
//---------------------------------------
Static function ColorOf( cName )
static hColors := {=>}
// any logic that assigns a different color to different values
if ! HHasKey( hColors, cName )
hColors[ cName ] := nRGB( HB_RandomInt( 0, 220 ), ;
HB_RandomInt( 0, 220 ), ;
HB_RandomInt( 0, 220 ) )
endif
return { CLR_WHITE, hColors[ cName ] }
//----------------------------------
static function SameAsNext( oCol )
local lSame := .f.
local nCol := oCol:nCreationOrder
local oBrw := oCol:oBrw
LOCAL xVALUE,yVALUE,zVALUE
xVALUE := oBrw:aCols[ nCol ]:Value
yVALUE := oBrw:aCols[ nCol+1 ]:Value
TRY
zVALUE := oBrw:aCols[ nCol-1 ]:Value
CATCH
zVALUE := "BOGUS"
END TRY
IF VALTYPE(xVALUE) <> "C"
xVALUE := STR(xVALUE)
ENDIF
IF VALTYPE(yVALUE) <> "C"
yVALUE := STR(yVALUE)
ENDIF
IF VALTYPE(zVALUE) <> "C"
zVALUE := STR(zVALUE )
ENDIF
IF VALTYPE( xVALUE) <> "C" .or. xVALUE = " "
lSAME := .F.
RETURN(lSAME)
ENDIF
IF xVALUE <> yVALUE
IF xVALUE = zVALUE
lSAME := .T.
RETURN(lSAME )
ENDIF
ENDIF
IF xVALUE <> yVALUE .and. nCOL > 5
IF xVALUE <> yVALUE
lSAME := .T.
RETURN(lSAME)
ENDIF
ENDIF
IF xVALUE = yVALUE
lSAME := .T.
ENDIF
/*
if nCol < Len( oBrw:aCols ) .and. oCol:Value == oBrw:aCols[ nCol + 1 ]:Value
lSame := .t.
endif
if ! lSame .and. nCol > 1 .and. oCol:Value == oBrw:aCols[ nCol - 1 ]:Value
lSame := .t.
endif
*/
RETURN( lSAME )
//-------------------------------------
function XbrGoToCol( oBrw, nCol1 )
oBrw:nColOffSet := nCol1 - oBrw:nFreeze
oBrw:nColSel := oBrw:nFreeze + 1
oBrw:ReFresh()
SysReFresh()
return nil
Thanks
Rick Lipkin
Re: xBrowse code block to evaluate fieldname()->value
Posted: Tue Jul 13, 2010 12:13 am
by nageswaragunupudi
Mr. Rick
Very nice.
Re: xBrowse code block to evaluate fieldname()->value
Posted: Tue Jul 13, 2010 12:17 am
by nageswaragunupudi
Mr. Rick
It is out of topic, but after seeing your VALID clause for MDICHILD, I recall the problem you were facing while closing the record set in the valid clause.
The best way is to close recordset / database in the oWnd:bPostEnd code block but not in the valid clause. This is executed after closing the MDIChild window.
