次の方法で共有

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

Comments

  • Anonymous
    November 21, 2005
    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.

  • Anonymous
    November 27, 2005
    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?

  • Anonymous
    November 28, 2005
    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.

  • Anonymous
    November 28, 2005
    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")

  • Anonymous
    December 07, 2005
    The comment has been removed

  • Anonymous
    March 20, 2006
    When you write code in any computer language, there are common constructs that alter the flow of control,...

  • Anonymous
    August 09, 2006
    The comment has been removed

  • Anonymous
    September 27, 2007
    I received an email with some sales figures in a table. I just pasted it into a new VFP program, added

  • Anonymous
    September 27, 2007
    Mike Potjer wins the prize! His explanation of the non-random nature of SYS(2015) is why it’s not a good

  • Anonymous
    January 19, 2009
    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.

  • Anonymous
    January 19, 2009
    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

  • Anonymous
    June 13, 2009
    PingBack from http://barstoolsite.info/story.php?id=101