I’ve seen demos of Excel 12 and it’s conditional formatting Data Bar and thought it was cool. In each cell, it draws a colored gradient bar with a width proportional to the cell’s value, making it easy to spot the largest/smallest values.

 

So I wrote a little code to do something similar in VFP.  Run the code below: try resizing the column, switching column order (by dragging the column header), resizing the form, varying the input. It calculates the number of orders per month from Northwind. It creates a gradient brush to fill a rectangle.

 

There’s lots of room for improvement: feel free to improve it!

 

  • I used Active Accessibility to get the cell locations: try exploring other methods
  • You can use AlphaBlend (as Excel does) to make the colors transparent (change the Alpha component of the colors specified in GdipCreateLineBrushFromRect)
  • With transparency, multiple paints will cause darkening.
  • The colors range from opaque blue to opaque white (0xff0000ff  to 0xffffffff)
  • Performance: try to minimize the IAccessible calls and calculations, perhaps by caching values.
  • Use MemberClassLibrary to make a column class with the gradient drawing functionality built in
  • Turn off the drawing for a cell if it’s being edited.
  • When a cell’s value changes the max, redraw all the bars.
  • Add error checking
  • Switching column order requires recalculating the oView member by calling GetAccObj
  • The maximum is based only on the visible values. You can fix that

.

 

The code calculates how many cells there are by getting the number of children of the view. This also gets cells that are beyond the end of file. To remedy this, it calls AccessibleObjectFromPoint to check if there is an actual grid cell at that point.

 

See also VFP\tools\msaa\AccBrow.pjx

 

#define           IAccGuid                "{618736E0-3C3D-11CF-810C-00AA00389B71}"

#define     OBJID_CLIENT        0xFFFFFFFC

#define     CHILDID_SELF        0

 

#define GWL_WNDPROC         (-4)

#define WM_PAINT                        0x000F

#define WM_ERASEBKGND                   0x0014

*from oleacc.h:

#define     ROLE_SYSTEM_COLUMNHEADER      ( 0x19 )

#define     ROLE_SYSTEM_ROW   ( 0x1c )

#define     ROLE_SYSTEM_CELL  ( 0x1d )

#define     ROLE_SYSTEM_INDICATOR   ( 0x27 )

#define     ROLE_SYSTEM_TEXT  ( 0x2a )

 

SYS(602,0)

PUBLIC oForm

 

 

OPEN DATABASE (HOME()+"\samples\Northwind\northwind")

SELECT PADL(YEAR(orderdate),4)+" /"+PADL(MONTH(orderdate),2," ") as Month,;

      COUNT(*) as data FROM orders GROUP BY 1 ORDER BY 1 INTO CURSOR freight

 

oForm=CREATEOBJECT("myform","Data")

oForm.show()

 

DEFINE CLASS myform as Form

      height=500

      width=600

      left=300

      top=0

      allowoutput=.f.

      nCol=0

      dwOrigWindProc=0

      oGraphics=0

      oBrush=0

      oRect=0

      oView=0     && ref to the Grid's view

      PROCEDURE load

            this.AddObject("grd","Grid")

            this.grd.height=thisform.Height-25

            this.grd.top = 20

            this.grd.anchor=15

            this.grd.width=thisform.Width-40

            this.grd.columns(2).width=300

            this.grd.visible=1

            DECLARE integer CLSIDFromString IN ole32 string , string @

            DECLARE integer AccessibleChildren IN oleacc.dll integer pAcc, integer childStart, integer nchildren, string @, integer @

            DECLARE INTEGER AccessibleObjectFromWindow IN oleacc.dll INTEGER , INTEGER , STRING , OBJECT @

            DECLARE INTEGER GetRoleText IN oleacc.dll INTEGER , STRING @, INTEGER

            DECLARE integer AccessibleObjectFromPoint IN oleacc integer x, integer y, object @ pAcc, string @ varChild

            DECLARE integer GetWindowLong IN WIN32API integer hWnd, integer nIndex

            DECLARE integer CallWindowProc IN WIN32API ;

                  integer lpPrevWndFunc, ;

                  integer hWnd,integer Msg,;

                  integer wParam,;

                  integer lParam

            DECLARE integer GdipCreateLineBrushFromRect ;

                  IN gdiplus.dll ;

                  string,;

                  integer,integer,;

                  integer, integer, integer @

            SET CLASSLIB TO HOME()+"ffc\_gdiplus"

      PROCEDURE init(cFldName)

            THIS.dwOrigWindProc =GetWindowLong(_VFP.HWnd,GWL_WNDPROC)

            BINDEVENT(thisform.hWnd, WM_PAINT,this,"HandleMsg")

            this.oGraphics=CREATEOBJECT("gpgraphics")

            this.oGraphics.CreateFromHWND(this.HWnd)

            this.oRect= CREATEOBJECT("gprectangle")

            this.oBrush=CREATEOBJECT("gphatchbrush",4)

            iidIDispatch=REPLICATE(CHR(0),16)

            CLSIDFromString(STRCONV("{00020400-0000-0000-C000-000000000046}"+CHR(0),5),@iidIDispatch)

            oAcc=0

            IF AccessibleObjectFromWindow(this.hwnd,OBJID_CLIENT,iidIDispatch,@oAcc) = 0

                  oColumn=this.GetAccObj(oAcc,0,PROPER(cFldName)) && Name of column to use

                  IF VARTYPE(oColumn)='O'

                        this.oView=oColumn.accParent.accParent    && 1st parent is ColumnHeader, 2nd parent is View

                  ENDIF

            ENDIF

      PROCEDURE resize

            this.oGraphics.CreateFromHWND(this.HWnd)

      PROCEDURE HandleMsg(hWnd as Integer, msg as Integer, wParam as Integer, lParam as Integer)

            nRetvalue= CallWindowProc(this.dwOrigWindProc ,hWnd,msg,wParam,lParam)

            this.FillColumnsWithGradient

            RETURN nRetvalue

      PROCEDURE FillColumnsWithGradient

            nValidRows=0

            nMaxVal=-1e6

            FOR i = 2 TO this.oView.accChildCount     && Loop calc max Ignore 1st child (column headers)

                  oRow=this.oView.accChild(i)

                  oCell=oRow.accChild(this.nCol+1).accChild(1)

                  nLeft=0

                  nTop=0

                  nWidth=0

                  nHeight=0

                  oCell.accLocation(@nLeft,@nTop,@nWidth,@nHeight,CHILDID_SELF)

                  varChild=REPLICATE(CHR(0),16) && sizeof(tagVARIANT) = 16

                  oHit=0

                  *if the hit test yields something that's not a cell, then must be EOF

                  IF AccessibleObjectFromPoint(nLeft+3,nTop+3,@oHit,@varChild)=0

                        IF oHIt.accRole == ROLE_SYSTEM_TEXT && we're still within valid data

                              nVal=VAL(oCell.accValue)

                              IF nVal>nMaxVal

                                    nMaxVal = nVal

                              ENDIF

                              nValidRows=nValidRows+1

                        ENDIF

                  ENDIF

            ENDFOR

            FOR i = 2 TO nValidRows+1     && Now loop, drawing gradient. Ignore 1st child (column headers)

                  oRow=this.oView.accChild(i)

                  oCell=oRow.accChild(this.nCol+1).accChild(1)

                  oCell.accLocation(@nLeft,@nTop,@nWidth,@nHeight,CHILDID_SELF)     && screen coordinates

                  this.oRect.x= nLeft -  thisform.left- _screen.left

                  this.oRect.y = nTop -  thisform.top - _screen.top  -31

                  this.oRect.w = CAST(nWidth * VAL(oCell.accValue) / nMaxVal - 25 as integer)

                  this.oRect.h = nHeight

                  nlBrush=0

                  GdipCreateLineBrushFromRect(this.oRect.GdipRectF,;

                        0xff0000ff,0xffffffff,2,0,@nlBrush) && 2 is LinearGradientModeForwardDiagonal

                  this.oBrush.SetHandle(nlBrush)

                  this.oGraphics.FillRectangle(this.oBrush,this.oRect)

            ENDFOR

      PROCEDURE GetAccObj(ox,nLevel,cSearch)

            LOCAL i,oc,oRet

            oRet=0

            nc=ox.accChildCount

            FOR i = 1 TO ox.accChildCount

                  oc=ox.accChild(i)

                  IF VARTYPE(oc)='O'

                        cStr=SPACE(40)

                        IF ""=cSearch

                              nlen=GetRoleText(oc.accRole,@cStr,LEN(cStr))

                              ?SPACE(nLevel*2),oc.accName," Role=",LEFT(cStr,nlen),oc.accRole

                        ELSE

                              IF oc.accRole = ROLE_SYSTEM_COLUMNHEADER AND oc.accName=cSearch

                                    this.nCol=i && Record which column

                                    RETURN oc

                              ENDIF

                        ENDIF

                        oRet=this.GetAccObj(oc,nLevel+1,cSearch)

                        IF VARTYPE(oRet)='O'

                              EXIT

                        ENDIF

                  ENDIF

            ENDFOR

            RETURN oRet

ENDDEFINE