xBrowse code block to evaluate fieldname()->value

[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 JONES
SMITH 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

[James Bott]

Rick,

Perhaps you can use this code sample for a starting point.

James

Code: Select all  Expand view

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

[nageswaragunupudi]

Mr. Rick

Please see this sample

Code: Select all  Expand view

#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.

[Rick Lipkin]

Rao and James

Thank you for your quick responce !! I will take a look shortly ..

Rick

[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 view

cVALUE := oBrw:aCols[ nCol ]:Value   // "A", "B" ..
 

Code: Select all  Expand view

 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

[nageswaragunupudi]

You want to have different colors for different names. Something like this?

Code: Select all  Expand view

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 ] }

 

[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

[Rick Lipkin]

Rao

Here is pretty much the final code based on your contribution and logic

Code: Select all  Expand view

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

[nageswaragunupudi]

Mr. Rick

Very nice.

[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.