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


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


            this.grd.top = 20


            this.grd.anchor=15


            this.grd.width=thisform.Width40


            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


 


 

Comments (12)

  1. Michel Roy says:

    Very nice. it works well even if you change row height. But if you change the size of the second column and then maximize the form it crashes.

  2. Theo Flabouras says:

    Calvin I think you’re doing a fantastic job with this weblog. I really like learning how vfp work inside and the way you used the iAccessible interface. It definetely needs performance optimization. In the past I had seen someone doing gradient bars in the background of the form, and I think he was sycnhronizing the from paint event with Horizontal Refresh. It must be in an Advisor issue, (4-5 years ago, but I’m not sure). Could you please give info about other lowlevel stuff mainly for the way gfx are drawn by VFP, but whatever else you have in hand to help us have a complete understanding of this wonderfull tool?

  3. Calvin_Hsia says:

    Thanks for the kind words Theo. Positive feedback has a way of encouraging more production. IAccessible is a COM interface and optimizations can be made by minimizing the number of COM calls. Usually, IAccessible is used for user interface operations, which are supposedly slower than computational tasks.

    Michel: you can easily fix the error message from maximizing the form. Clue: try removing the Resize code to see what happens.

  4. Michel Roy says:

    I don’t know if that is what i was supposed to do, but i fixed it by doing

    PROCEDURE resize

    UNBINDEVENT(thisform.hWnd)

    this.oGraphics.CreateFromHWND(this.HWnd)

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

  5. VERY sharp looking ! Mentioned to me on the Visual Maxframe board by Jan-Peter Groeneweg. I’d just done the same thing this morning but with minimal code by putting a shape in a container, which I then dropped into a grid column. One line of code in the container backtyle_access method to set the shape width based on value of data in another column made it work. But my graph shapes are either solid or one of the VFP fill styles, not the sharp gradient look you have. Oh well.

  6. When you write code in any computer language, there are common constructs that alter the flow of control,…

  7. I was asked why Tooltips appear in Task Manager. I happened to be out of the country when the question…

  8. I received an email with some sales figures in a table. I just pasted it into a new VFP program, added

  9. Mike Potjer wins the prize! His explanation of the non-random nature of SYS(2015) is why it’s not a good

  10. Hi Calvin

    Its a nice job.I see some analog thing in SPS Weblog.

    But if you move the form or resize it you have some bugs.

    Make form.borderstyle=2 and maxbutton=.f.

    if showwindow=2 (top level form)that dont work ?

    "Bon courage" and thank you.

  11. for remaining to the problem of resizing,moving the form can add simply this code:

    PROCEDURE MOVED

            thisform.grd.refresh

    I test it and it works.

    regards