Excel's new gradient Data Bar feature is cool: you can do it too!

Article
11/21/2005

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