FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin for Harbour/xHarbour xBrowse FillRect ( follow up ) -- Rao
Posts: 2706
Joined: Fri Oct 07, 2005 01:50 PM
xBrowse FillRect ( follow up ) -- Rao
Posted: Wed Jul 03, 2013 01:31 PM
Rao

I am re-visiting this topic and I have created the two arrays aSchedule ( first screen shot )
and aDuration ( second screen shot ) and I am struggling to interpret your suggestion on drawing the rectangle .. I would appreciate your help!

Rick Lipkin


Just prepare the array like this. Prepare another array of same size with duration in the corresponding cell of the second array. Keep the duration as number of half-hours ( that gives the number of rows )

Example:
If aData[ 3, 4 ] contains an appointment, aDurn[ 3, 4 ] contains its duration. If the duration is less than 1/2 hour the value is 1. If more than 1/2 hour and less than 1 hour the value is 2. etc.

Then we can draw the cells on our own. Thats a lot better. First please make the two arrays.

I am also assuming that all the rows of the browse will fit into one screen. Right? Or not?


To color a rectangle:

Assume we have two Arrays as static vars.
aSelRows := { nTop, nBottom }
aSelCols := { nLeft, nRight }
Note: I am using two arrays instead one aRect, because this logic easily enables using oBrw:aSelected.

Code:

for each oCol in oBrw:aCols
SetClrStd( oCol )
next
....
....
static function SetClrStd( oCol )

oCol:bClrStd := { || { CLR_BLACK, If( oCol:BookMark >= aSelRows[ 1 ] .and. oCol:BookMark <= aSelRows[ 2 ] .and. oCol:nPos >= aSelCols[ 1 ] .and. oCol:nPos <= aSelCols[ 2 ], CLR_YELLOW, CLR_WHITE ) } }


aSchedule - master array


aDuration - same array with duration .. number in integer = 30 min


xBrowse - actual program
Posts: 2706
Joined: Fri Oct 07, 2005 01:50 PM
Re: xBrowse FillRect ( follow up )
Posted: Sat Jul 27, 2013 01:22 PM

To All

I am still struggling to figure out a way to paint a rectangle in xBrowse. Two problems:

1) Determining the top, bottom, right and left
2) the syntax to draw the rectangle with transparent text and color

Many Thanks!
Rick Lipkin

Posts: 10733
Joined: Sun Nov 19, 2006 05:22 AM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Sat Jul 27, 2013 01:25 PM

Mr Rick

Sorry
Soon I shall find an answer for u

Regards



G. N. Rao.

Hyderabad, India
Posts: 2706
Joined: Fri Oct 07, 2005 01:50 PM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Sat Jul 27, 2013 01:26 PM

Rao

Thank you !! If you need any code from me I will be happy to share.

Rick Lipkin

Posts: 10733
Joined: Sun Nov 19, 2006 05:22 AM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Sat Jul 27, 2013 02:30 PM

I have ur email

Regards



G. N. Rao.

Hyderabad, India
Posts: 2706
Joined: Fri Oct 07, 2005 01:50 PM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Sat Jul 27, 2013 02:32 PM

Rao

I will send you the updated code with the secondary array ..

Rick Lipkin

Posts: 2706
Joined: Fri Oct 07, 2005 01:50 PM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Mon Aug 12, 2013 02:27 PM
Rao

I know you have been quite busy .. I just need a way to be able to interrogate each cell ( array element) at runtime and determine its contents, row and column. .. perhaps something like you suggested earlier ??

That would help me a lot!
Rick Lipkin

Code (fw): Select all Collapse
for each oCol in oLbxA:aCols
     // some function to interrogate each cell as browse paints then fillrect
next


//----------
Static FUnc to get values and paint a fillrec()

nColumn := oLbxA:nAt
nRow    := oLbxA:KeyNo()
cText   := oLbxA:aCols[ nColumn ]:Value
Posts: 10733
Joined: Sun Nov 19, 2006 05:22 AM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Wed Aug 14, 2013 04:04 AM

for each oCol in oBrw:aCols
oCol:Value --> gives the value of the cell
next

Regards



G. N. Rao.

Hyderabad, India
Posts: 4043
Joined: Wed Dec 19, 2007 06:40 PM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Thu Aug 15, 2013 08:33 AM
Rick,

a full ready to use sample.
To keep it small in size, nothing special added.
Select any of the < filter-buttons > to fill the cells at runtime.
Maybe it helps.

Download :
http://www.pflegeplus.com/fw_downloads/Cellcol1.zip



This sample is included in my new tool, I'm working on :



Best Regards
Uwe :-)
Since 1995 ( the first release of FW 1.9 )

i work with FW.

If you have any questions about special functions, maybe i can help.
Posts: 10733
Joined: Sun Nov 19, 2006 05:22 AM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Mon Aug 19, 2013 02:09 PM
Mr Rick

sorry for the delay. Please try this logic.
Starting from the data (similar to your data, building the arrays and browsing.
You may make appropriate changes.

Code (fw): Select all Collapse
#include "fivewin.ch"
#include "xbrowse.ch"
#include "hbcompat.ch"  // important for AINS translation

static aData, aSched, aColor, aTech
static aPer

function Main()

   local nPeriods
   local n, nRow, nAt, nSlot, nTech, cTech

   // period array
   aPer  := {}
   for n := 8 to 16
      AAdd( aPer, StrZero( n, 2 ) + ":00" )
      AAdd( aPer, StrZero( n, 2 ) + ":30" )
   next
   nPeriods := Len( aPer )

   // Raw Data read from Table filtered to date
   aData := { ;
   { "08:00", "08:30", "Angelo Russo", "Basset Hound" }, ;
   { "10:30", "11:30", "Angelo Russo", "Bulldog" }, ;
   { "09:30", "10:00", "Anne Jocobs",  "Sheperd" }, ;
   { "11:00", "12:00", "Anne Jocobs",  "Sheperd" }, ;
   { "08:30", "10:30", "Lea Allen",    "Beagle"  }, ;
   { "12:30", "13:30", "Lea Allen",    "Beagle"  }  }

   // Prepare shedule and color arrays

   aSched   := {}
   aColor   := {}
   aTech    := {}

   for nRow := 1 to Len( aData )
      cTech       := aData[ nRow, 3 ]
      nTech       := AScan( aTech, { |c| Upper( c ) == Upper( cTech ) } )
      if nTech == 0
         AAdd( aTech, cTech )
         nTech    := Len( aTech )
         AAdd( aSched, Array( nPeriods ) )
         AAdd( aColor, Array( nPeriods ) )
      endif
      // Post sched in the time slot
      nSlot    := AScan( aPer, { |c| aData[ nRow, 1 ] == c } )
      if nSlot == 0
         nSlot := nPeriods
      endif
      aSched[ nTech, nSlot ]  := aData[ nRow, 4 ]
      nAt      := AScan( aPer, { |c| aData[ nRow, 2 ] == c } )
      if nAt == 0
         nAt   := nPeriods
      endif
      nAt--
      if nAt > nSlot
         for n := nSlot to nAt
            aColor[ nTech, n ] := .t.
         next
      endif
   next nRow

   // Rearrange the arrays
   AIns( aSched, 1, aPer, .t. )
   AIns( aColor, 1, nil, .t. )
   AIns( aTech,  1, "TIME", .t. )
   aSched   := ArrTranspose( aSched )
   aColor   := ArrTranspose( aColor )

   XBROWSER aSched TITLE "Schedule" SETUP BrwSetup( oBrw )

return nil

static function BrwSetup( oBrw )

   local n, oCol

   oBrw:cHeaders     :=  aTech
   for n := 2 to Len( oBrw:aCols )
      oCol  := oBrw:aCols[ n ]
      oCol:bClrStd := CellColorBlock( oCol )
   next

return nil

static function CellColorBlock( oCol )

   local oBrw := oCol:oBrw

return { || If( aColor[ oBrw:nArrayAt, oCol:nArrayCol ] == .t., ;
               { CLR_WHITE, CLR_GREEN }, { CLR_BLACK, CLR_WHITE } ) }


Regards



G. N. Rao.

Hyderabad, India
Posts: 2706
Joined: Fri Oct 07, 2005 01:50 PM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Mon Aug 19, 2013 02:38 PM

Rao

Thank you for your support .. I will let you know ...

Very Much Appreciated!
Rick Lipkin

Posts: 2706
Joined: Fri Oct 07, 2005 01:50 PM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Mon Sep 02, 2013 09:18 PM
Rao

I am just now trying to adapt your code without much success. In your example, you create your browse much different than I do, however, in the following code I do not think it makes much difference.

I prefer to use your technique of using a second array which points back to the array element(s) to be colored.

Here is my code and the screenshot of a duplicated array ( just for testing ) called aDuration. The viewable xBrowse array is called aSchedule. I did find some other code here in the forum that does work but only scans aSchedule and not aDuration.

What I think your code does is scan ( in my case ) aSchedule to get the array element and looks to same aDuration cell value ( logical or char value ) which maps back to aSchedule to be painted.
Code (fw): Select all Collapse
DEFINE ICON oIco RESOURCE "APTBOOK"

DEFINE WINDOW oWndChildA           ;
       FROM 0,0 to 37.5,123        ;
       MDICHILD                    ;
       OF oWnd                     ;
       NOMINIMIZE                  ;
       ICON oIco                   ;
       TITLE xTITLE

       DEFINE DIALOG oSch RESOURCE "SCHEDULE" of oWndChildA

       REDEFINE xBROWSE oLbxA        ;
         ARRAY aSchedule             ;
         HEADERS aHeader             ;
         COLSIZES aColumn            ;
         ID 172 of oSch              ;
       AUTOCOLS LINES CELL

       oLbxA:nRowHeight() := 45
       oLbxA:nFreeze := 1

       // adapting rao's code
       // can not get to work
       for i := 2 to Len( oLbxA:aCols )
           oCol  := oLbxA:aCols[ i ]
           oCol:bClrStd := CellColorBlock( oCol,aDuration )
       next
 
        // another example
     *  FOR i = 2 to LEN( oLbxA:aCols )
     *      oLbxA:aCols[ i ]:bClrStd := ChangeColor( oLbxA, i )
     *  NEXT

    ...

//---------------------------
Static Func ChangeColor( oLbxA, i ) //

Local nColumn,nRow,cText


*Return {|| { ColorCell( oLbxA:aCols[ i ]:Value ), ColorCell( oLbxA:aCols[ i ]:Value ) } }
Return {||  { CLR_BLACK, ColorCell( oLbxA:aCols[ i ]:Value ) } }

//-------------------
Static Func ColorCell( cText )

LOCAL nColor

DO CASE
*CASE uDato == 1 // AMARILLO-PAGADAS AL DIA
*nColor := RGB(255, 255, 128)

*CASE uDato == 2 // AZUL-PAGADAS ADELANTADAS
*nColor := RGB(0, 100, 200)

CASE cText <> "  " //== 3 // MARRON CLARO-PAGADAS CON ATRASO  // this works
nColor := RGB(255, 172, 89)

*CASE uDato == 9 // ROJO-CUOTAS VENCIDAS
*nColor := RGB(240, 0, 0)

OTHERWISE
nColor := GetSysColor( 5 )

ENDCASE

RETURN( nColor )

//----------------------------
Static function CellColorBlock( oCol,aDuration )

local oBrw

oBrw := oCol:oBrw


Return { || If( aDuration[ oBrw:nArrayAt, oCol:nArrayCol ] <> "  ",;//== "B", ;//.t., ;
               { CLR_WHITE, CLR_BLUE }, { CLR_BLACK, CLR_WHITE } ) }

At this point the code is looking for an element that is NOT blank, however when I adapt the aDuration, I will use a charactor ( like "B", "G" ) to determine the color.. unfortunitly, I can not seem to get your code to work.

I can easily create aDuration with the above charactor codes instead of your logical .. for some reason, I just can not seem to understand how to evaluate the values .. I seem to be able to get one row and that is it .. however, I know the for\next look is evaluating every element.

Please have a look at let me know that I am missing.

Thanks
Rick Lipkin

Posts: 10733
Joined: Sun Nov 19, 2006 05:22 AM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Mon Sep 02, 2013 11:16 PM
I can easily create aDuration with the above charactor codes instead of your logical .. for some reason, I just can not seem to understand how to evaluate the values .. I seem to be able to get one row and that is it .. however, I know the for\next look is evaluating every element.

I understand that if an appointment spans from cell [nRow,nCo] to [nRow+d,nCol] than aDuration[nRow,nCol] to aDuration[nRow+d,nCol] contain some color code.
In other cases aDuration[y,x] contains NIL.

I suggest you assign a color pair straigh away instead of a color code. Then

Code (fw): Select all Collapse
Static function CellColorBlock( oCol,aDuration )

local oBrw

oBrw := oCol:oBrw

Return { || IfNil( aDuration[ oBrw:nArrayAt, oCol:nArrayCol ], { CLR_BLACK, CLR_WHITE } ) }
Regards



G. N. Rao.

Hyderabad, India
Posts: 2706
Joined: Fri Oct 07, 2005 01:50 PM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Tue Sep 03, 2013 01:08 PM
Rao

I think your original code will work .. I just can not seem to get this part working .. I was testing your code against my version of the duration array .. all I was looking to test for was if the value of the array element was blank .. I don't think any of the values are nil ??

Rick Lipkin

Code (fw): Select all Collapse
//----------------------------
Static function CellColorBlock( oCol,aDuration )

local oBrw

oBrw := oCol:oBrw


Return { || If( aDuration[ oBrw:nArrayAt, oCol:nArrayCol ] <> "  ",;//== "B", ;//.t., ;
               { CLR_WHITE, CLR_BLUE }, { CLR_BLACK, CLR_WHITE } ) }
Posts: 10733
Joined: Sun Nov 19, 2006 05:22 AM
Re: xBrowse FillRect ( follow up ) -- Rao
Posted: Wed Sep 04, 2013 07:48 AM
I tried to keep everything simple in my code. I assigned some value to a cell in the aColor ( or aDuration ) array only when needed and otherwise retained the default nil values. Saves time while preparing the array. And saves confusion while deriving color values later.

Now applying my suggestion to use color pairs instead of logical .t., this is the revised sample.
Code (fw): Select all Collapse
#include "fivewin.ch"
#include "xbrowse.ch"
#include "hbcompat.ch"  // important for AINS translation

static aData, aSched, aColor, aTech
static aPer

#define CLRPAIR1  { CLR_WHITE, CLR_GREEN }
#define CLRPAIR2  { CLR_BLACK, CLR_HRED }


function Main()

   local nPeriods
   local n, nRow, nAt, nSlot, nTech, cTech

   // period array
   aPer  := {}
   for n := 8 to 16
      AAdd( aPer, StrZero( n, 2 ) + ":00" )
      AAdd( aPer, StrZero( n, 2 ) + ":30" )
   next
   nPeriods := Len( aPer )

   // Raw Data read from Table filtered to date
   aData := { ;
   { "08:00", "08:30", "Angelo Russo", "Basset Hound" }, ;
   { "10:30", "11:30", "Angelo Russo", "Bulldog" }, ;
   { "09:30", "10:00", "Anne Jocobs",  "Sheperd" }, ;
   { "11:00", "12:00", "Anne Jocobs",  "Sheperd" }, ;
   { "08:30", "10:30", "Lea Allen",    "Beagle"  }, ;
   { "12:30", "13:30", "Lea Allen",    "Beagle"  }  }

   // Prepare shedule and color arrays

   aSched   := {}
   aColor   := {}
   aTech    := {}

   for nRow := 1 to Len( aData )
      cTech       := aData[ nRow, 3 ]
      nTech       := AScan( aTech, { |c| Upper( c ) == Upper( cTech ) } )
      if nTech == 0
         AAdd( aTech, cTech )
         nTech    := Len( aTech )
         AAdd( aSched, Array( nPeriods ) )
         AAdd( aColor, Array( nPeriods ) )
      endif
      // Post sched in the time slot
      nSlot    := AScan( aPer, { |c| aData[ nRow, 1 ] == c } )
      if nSlot == 0
         nSlot := nPeriods
      endif
      aSched[ nTech, nSlot ]  := aData[ nRow, 4 ]
      nAt      := AScan( aPer, { |c| aData[ nRow, 2 ] == c } )
      if nAt == 0
         nAt   := nPeriods
      endif
      nAt--
      if nAt > nSlot
         for n := nSlot to nAt
            aColor[ nTech, n ] := If( nTech == 2, CLRPAIR2, CLRPAIR1 )
         next
      endif
   next nRow

   // Rearrange the arrays
   AIns( aSched, 1, aPer, .t. )
   AIns( aColor, 1, nil, .t. )
   AIns( aTech,  1, "TIME", .t. )
   aSched   := ArrTranspose( aSched )
   aColor   := ArrTranspose( aColor )

   XBROWSER aSched TITLE "Schedule" SETUP BrwSetup( oBrw )

return nil

static function BrwSetup( oBrw )

   local n, oCol

   oBrw:cHeaders     :=  aTech
   for n := 2 to Len( oBrw:aCols )
      oCol  := oBrw:aCols[ n ]
      oCol:bClrStd := CellColorBlock( oCol )
   next

return nil

static function CellColorBlock( oCol )

   local oBrw := oCol:oBrw

return { || IfNil( aColor[ oBrw:nArrayAt, oCol:nArrayCol ], { CLR_BLACK, CLR_WHITE } ) }


Regards



G. N. Rao.

Hyderabad, India