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!
.
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
PROCEDURE resize
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
nValidRows=nValidRows+1
ENDFOR
FOR i = 2 TO nValidRows+1 && Now loop, drawing gradient. Ignore 1st child (column headers)
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)
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
oRet=this.GetAccObj(oc,nLevel+1,cSearch)
IF VARTYPE(oRet)='O'
EXIT
RETURN oRet
ENDDEFINE