Wiki Home

Select Range Of Records In Grid


Namespace: Wiki
I've recently had a client request they be able to print a range of records within a grid so I've come up with something that works pretty well. I thought I'd post it so people looking for the same thing could use this as their basis. The reason I did this is because my client wanted to print a certain range of records without having to go back and requery further down the list. For example, this client wanted to produce a list of produts in a certain warehouse that had been on the shelf for longer than 3 months. This list produced 250+ products, but they wanted specific ones that came from one of their suppliers. Instead of them going back to requery again, they wanted a way to select a range (say record 10-25) and print those. I finally came up with the following solution. It works pretty slick (I think). I'm sure there could be tweaks to it so if you have ideas, please share: This certain program will ask you to choose a table to open so you can have your choice. Note that it doesn't print or anything like that. I just provided a way to select a range of cells in a grid. You then would use thisform.nStart and thisform.nEnd for starting and ending record number. If you have questions or comments: email is dl1972@hotmail.com

PUBLIC oGridForm
oGridForm = CREATEOBJECT("frmgrid")
oGridForm.SHOW

**************************************************
*-- Class:        frmgrid (test.vcx)
*-- ParentClass:  form
*-- BaseClass:    form
*-- Time Stamp:   03/30/04 12:03:09 PM
*
DEFINE CLASS frmgrid AS FORM


	HEIGHT = 329
	WIDTH = 512
	DOCREATE = .T.
	AUTOCENTER = .T.
	CAPTION = "Grid Select"
	KEYPREVIEW = .T.
	nend = 0
	nstart = 0
	nmousey = 0
	nmousex = 0
	ncursorposy = 0
	ncursorposx = 0
	mclip = ""
	nstartposx = 0
	nstartposy = 0
	NAME = "frmgridselect"


	ADD OBJECT label1 AS LABEL WITH ;
		WORDWRAP = .T., ;
		CAPTION = "Click and Drag within the grid, or hold down shift while pressing the cursor arrows, or shift+click on the grid", ;
		HEIGHT = 33, ;
		LEFT = 72, ;
		TOP = 3, ;
		WIDTH = 388, ;
		NAME = "Label1"


	ADD OBJECT mygrid AS mygrid WITH ;
		WIDTH = 471, ;
		HEIGHT = 255, ;
		TOP = 39, ;
		LEFT = 21, ;
		DELETEMARK = .F., ;
		SCROLLBARS = 2


	ADD OBJECT cnt1 AS cnt1 WITH ;
		OLEDRAGMODE = 1, ;
		OLEDROPMODE = 1, ;
		TOP = 58, ;
		LEFT = 31, ;
		WIDTH = 443, ;
		HEIGHT = 236, ;
		BACKSTYLE = 0, ;
		BORDERWIDTH = 0, ;
		NAME = "cnt1"


	PROCEDURE buf2dword
		LPARAMETERS lcBuffer
		RETURN ASC(SUBSTR(lcBuffer,1,1)) + ;
			BITLSHIFT(ASC(SUBSTR(lcBuffer,2,1)),  8)+;
			BITLSHIFT(ASC(SUBSTR(lcBuffer,3,1)), 16)+;
			BITLSHIFT(ASC(SUBSTR(lcBuffer,4,1)), 24)
	ENDPROC


	PROCEDURE drawbox
		*** DrawBox()
		LOCAL nX, nY, cCursorPos, nRelRow
		*** lock screen to help in "flashiness"

		THISFORM.LOCKSCREEN = .T.
		*** get mouse position for form
		m.nX = MCOL()*5
		m.nY = MROW()*15
		*** get mouse position for Windows
		m.cCursorPos = SPACE(8)
		=GetCursorPos(@cCursorPos)
		WITH THISFORM.cnt1.shpSelected
			IF .VISIBLE = .F.
				*** if shape isn't visible, make it visible and set position of it
				.LEFT=m.nX - THISFORM.cnt1.LEFT
				.TOP=m.nY - THISFORM.cnt1.TOP
				.VISIBLE = .T.
				*** set form properties to hold top and left of shape
				THISFORM.nmousex = .LEFT
				THISFORM.nmousey = .TOP
				*** set form properties to hold top and left of mouse position relative to windows
				THISFORM.nstartposx = SUBSTR(cCursorPos,1,4)
				THISFORM.nstartposx = ASC(SUBSTR(THISFORM.nstartposx , 1,1)) + ;
					ASC(SUBSTR(THISFORM.nstartposx , 2,1)) * 256 +;
					ASC(SUBSTR(THISFORM.nstartposx , 3,1)) * 65536 +;
					ASC(SUBSTR(THISFORM.nstartposx , 4,1)) * 16777216
				THISFORM.nstartposy = SUBSTR(cCursorPos,5,4)
				THISFORM.nstartposy = ASC(SUBSTR(THISFORM.nstartposy , 1,1)) + ;
					ASC(SUBSTR(THISFORM.nstartposy , 2,1)) * 256 +;
					ASC(SUBSTR(THISFORM.nstartposy , 3,1)) * 65536 +;
					ASC(SUBSTR(THISFORM.nstartposy , 4,1)) * 16777216
			ELSE
				*** set form properties to hold top and left of mouse position relative to windows
				THISFORM.ncursorposx = SUBSTR(cCursorPos,1,4)
				THISFORM.ncursorposx = ASC(SUBSTR(THISFORM.ncursorposx , 1,1)) + ;
					ASC(SUBSTR(THISFORM.ncursorposx , 2,1)) * 256 +;
					ASC(SUBSTR(THISFORM.ncursorposx , 3,1)) * 65536 +;
					ASC(SUBSTR(THISFORM.ncursorposx , 4,1)) * 16777216
				THISFORM.ncursorposy = SUBSTR(cCursorPos,5,4)
				THISFORM.ncursorposy = ASC(SUBSTR(THISFORM.ncursorposy , 1,1)) + ;
					ASC(SUBSTR(THISFORM.ncursorposy , 2,1)) * 256 +;
					ASC(SUBSTR(THISFORM.ncursorposy , 3,1)) * 65536 +;
					ASC(SUBSTR(THISFORM.ncursorposy , 4,1)) * 16777216


				DO CASE

						*** if X position is within the container and to the right of shape.left,
						*** then add to the width
					CASE BETWEEN(m.nX, THISFORM.cnt1.LEFT+.LEFT,THISFORM.cnt1.LEFT+THISFORM.cnt1.WIDTH)
						.WIDTH = m.nX-.LEFT - THISFORM.cnt1.LEFT

						*** if X position is to the left of shape.left,
						*** then set the cursor position to shape.left
					CASE m.nX < THISFORM.LEFT+.LEFT
						SetCursorPos(THISFORM.nstartposx,THISFORM.ncursorposy)

						*** otherwise, set the cursor position to shape.right, current Y
					OTHERWISE
						SetCursorPos(m.nX+THISFORM.LEFT,THISFORM.ncursorposy)

				ENDCASE

				DO CASE

						*** if Y position is below the container, then skip and reset top and height of shape
					CASE m.nY > THISFORM.cnt1.TOP+THISFORM.cnt1.HEIGHT
						IF m.nX < THISFORM.cnt1.LEFT+THISFORM.cnt1.WIDTH
							m.nRelRow = THISFORM.mygrid.RELATIVEROW
							m.nRecno = RECNO()
							IF NOT EOF()
								SKIP
							ENDIF
							IF EOF()
								GO BOTTOM
							ENDIF
							IF NOT m.nRecno == RECNO()
								.TOP = .TOP - THISFORM.mygrid.ROWHEIGHT
								.HEIGHT = .HEIGHT + THISFORM.mygrid.ROWHEIGHT
								THISFORM.nstartposy = THISFORM.nstartposy - THISFORM.mygrid.ROWHEIGHT
								THISFORM.mygrid.REFRESH()
								DO WHILE THISFORM.mygrid.RELATIVEROW # m.nRelRow OR THISFORM.mygrid.RELATIVEROW = 0
									THISFORM.mygrid.DOSCROLL(0)
								ENDDO
							ENDIF
						ENDIF

						*** if Y position is above the container, then skip-1 and reset top and height of shape
					CASE m.nY > 0 AND m.nY < THISFORM.cnt1.TOP AND THISFORM.nstart # THISFORM.mygrid.ACTIVEROW AND .TOP < 0
						m.nRelRow = THISFORM.mygrid.RELATIVEROW
						m.nRecno = RECNO()
						IF NOT BOF()
							SKIP -1
						ENDIF
						IF BOF()
							GO TOP
						ENDIF
						IF NOT m.nRecno == RECNO()
							.TOP = .TOP + THISFORM.mygrid.ROWHEIGHT
							.HEIGHT = MAX(.HEIGHT - THISFORM.mygrid.ROWHEIGHT,0)
							THISFORM.nstartposy = THISFORM.nstartposy + THISFORM.mygrid.ROWHEIGHT
							THISFORM.mygrid.REFRESH()
							DO WHILE THISFORM.mygrid.RELATIVEROW # m.nRelRow OR THISFORM.mygrid.RELATIVEROW = 0
								THISFORM.mygrid.DOSCROLL(1)
							ENDDO
						ENDIF

						*** if Y position is lower than the shape's top, then set the height and activate the cell
					CASE BETWEEN(m.nY, THISFORM.cnt1.TOP+.TOP,THISFORM.cnt1.TOP+THISFORM.cnt1.HEIGHT)
						.HEIGHT = m.nY-.TOP - THISFORM.cnt1.TOP
						THISFORM.MakeCellActive()

						*** otherwise, set the cursor position to the current x, shape.top
					OTHERWISE
						SetCursorPos(THISFORM.ncursorposx,THISFORM.nstartposy)

				ENDCASE

			ENDIF
		ENDWITH


		*** set ending recno to current recno for display purposes
		THISFORM.nend = RECNO()
		THISFORM.mygrid.REFRESH()
		THISFORM.LOCKSCREEN = .F.
	ENDPROC


	PROCEDURE num2rect
		*** Num2Rect()
		LPARAMETERS lnLeft, lnTop, lnRight, lnBottom
		RETURN THIS.num2buf(lnLeft) + THIS.num2buf(lnTop)+;
			THIS.num2buf(lnRight) + THIS.num2buf(lnBottom)
	ENDPROC


	PROCEDURE MakeCellActive
		*** MakeCellActive()
		*** activates cell in grid while dragging based on where mouse cursor is
		LOCAL lnWhere, lnRelRow, lnRelCol, lnX, lcColumn
		STORE 0 TO lnWhere, lnRelRow, lnRelCol

		THISFORM.mygrid.GridHitTest(MCOL()*5, MROW()*15, @lnWhere, @lnRelRow, @lnRelCol)
		THISFORM.mygrid.ACTIVATECELL(lnRelRow,lnRelCol)
	ENDPROC


	PROCEDURE num2buf
		*** num2buf()
		LPARAMETERS  lnValue
		#DEFINE m0       256
		#DEFINE m1     65536
		#DEFINE m2  16777216
		LOCAL b0, b1, b2, b3
		b3 = INT(lnValue/m2)
		b2 = INT((lnValue - b3 * m2)/m1)
		b1 = INT((lnValue - b3*m2 - b2*m1)/m0)
		b0 = MOD(lnValue, m0)
		RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3)
	ENDPROC


	PROCEDURE cliptoform
		*** ClipToForm()
		*** lock the mouse cursor within the container widths and the form heights
		*** I had problems when I went past the form on either side, and when I went past the container on the bottom right.
		*** Since I clip Windows this way, the mouse cannot go past the boundaries
		LOCAL HWND, lcBuffer, nTopX, nTopY, nBottX, nBottY

		HWND = Getfocus()
		lcBuffer = CHR(60) +;
			REPLI(CHR(0), 60-1)
		=GetWindowInfo(HWND, @lcBuffer)
		wrleft = THISFORM.buf2dword(SUBS(lcBuffer, 5,4))
		wrtop  = THISFORM.buf2dword(SUBS(lcBuffer, 9,4))
		wrright = THISFORM.buf2dword(SUBS(lcBuffer, 13,4))
		wrbottom = THISFORM.buf2dword(SUBS(lcBuffer, 17,4))
		lcBuffer = THISFORM.num2rect(wrleft+THISFORM.cnt1.LEFT, wrtop+24, wrleft+THISFORM.cnt1.LEFT+THISFORM.cnt1.WIDTH, wrbottom-5)
		=ClipCursor(lcBuffer)
	ENDPROC


	PROCEDURE INIT
		LOCAL lpRect
		DECLARE LONG SetCursorPos IN user32 LONG, LONG
		DECLARE SHORT GetCursorPos IN user32 STRING @ lpPoint
		DECLARE INTEGER ClipCursor IN user32 STRING lpRect
		DECLARE INTEGER GetClipCursor IN user32 STRING @ lpRect
		DECLARE INTEGER GetFocus IN user32
		DECLARE INTEGER GetWindowInfo IN user32 INTEGER HWND, STRING @pwi

		* save initial clipping area to revert back to it after drag
		lpRect = REPLI (CHR(0), 16)
		= GetClipCursor (@lpRect)
		THIS.mclip = lpRect

		THIS.mygrid.SetGrid()

		RETURN DODEFAULT()
	ENDPROC


	PROCEDURE KEYPRESS
		LPARAMETERS nKeyCode, nShiftAltCtrl

		IF INLIST(m.nKeyCode,50,56) AND LOWER(THISFORM.ACTIVECONTROL.NAME)='mygrid'
			IF THISFORM.nstart = 0 OR NOT BETWEEN(RECNO(),THISFORM.nstart,THISFORM.nend)
				THISFORM.nstart = RECNO()
				THISFORM.nend = RECNO()
			ENDIF

			DO CASE

				CASE  m.nKeyCode = 50  && down arrow
					IF NOT EOF()
						SKIP
					ENDIF
					IF EOF()
						GO BOTTOM
					ENDIF
					THISFORM.nend = RECNO()

				CASE m.nKeyCode = 56  && up arrow
					IF NOT BOF()
						SKIP -1
					ENDIF
					IF BOF()
						GO TOP
					ENDIF
					IF THISFORM.nstart > RECNO()
						THISFORM.nstart = RECNO()
					ELSE
						THISFORM.nend = RECNO()
					ENDIF

			ENDCASE

			THISFORM.mygrid.REFRESH()
		ENDIF
		RETURN DODEFAULT(nKeyCode,nShiftAltCtrl)
	ENDPROC




ENDDEFINE

DEFINE CLASS mygrid AS GRID
	COLUMNCOUNT = 0

	PROCEDURE SetGrid
		THISFORM.LOCKSCREEN = .T.
		lcFileName = GETFILE("DBF","Select Table:")
		USE (lcFileName)
		lcAlias = ALIAS()
		THIS.RECORDSOURCE = ""
		THIS.RECORDSOURCE = lcAlias
		SELECT (lcAlias )
		FOR i = 1 TO FCOUNT()
			IF THIS.COLUMNCOUNT < i
				THIS.ADDOBJECT("column" + ALLTRIM(STR(i)),"MyColumn")
			ENDIF
			THIS.COLUMNS(i).VISIBLE = .T.
			THIS.COLUMNS(i).CONTROLSOURCE = FIELD(i)
			THIS.COLUMNS(i).DYNAMICBACKCOLOR="IIF(between(RECNO(),thisform.nStart,thisform.nEnd), RGB(185,217,255), RGB(255,255,255))"
			THIS.COLUMNS(i).Header1.CAPTION = FIELD(i)
		ENDFOR
		FOR i = FCOUNT() + 1 TO THIS.COLUMNCOUNT
			THIS.REMOVEOBJECT("Column"+ALLTRIM(STR(i)))
		ENDFOR
		THISFORM.CAPTION = lcAlias
		THIS.SETALL("DynamicBackColor", "IIF(between(RECNO(),thisform.nStart,thisform.nEnd), RGB(185,217,255), RGB(255,255,255))", "Column")
		THISFORM.LOCKSCREEN = .F.
	ENDPROC

ENDDEFINE

DEFINE CLASS myColumn AS COLUMN

	ADD OBJECT Header1 AS myHeader WITH VISIBLE = .T.

ENDDEFINE

DEFINE CLASS myHeader AS HEADER
ENDDEFINE

DEFINE CLASS cnt1 AS CONTAINER
	PROCEDURE MOUSEDOWN
		LPARAMETERS nButton, nShift, nXCoord, nYCoord

		LOCAL lSetEnd

		*** if shift was held down, then set start row / end row form properties
		IF m.nShift = 1
			m.lSetEnd = .T.
			IF THISFORM.nstart = 0 OR NOT BETWEEN(RECNO(),THISFORM.nstart,THISFORM.nend)
				THISFORM.nstart = RECNO()
				THISFORM.nend = RECNO()
			ENDIF
		ENDIF
		*** activate cell under mouse
		THISFORM.MakeCellActive()

		IF m.lSetEnd
			IF RECNO() > THISFORM.nstart
				THISFORM.nend = RECNO()
			ELSE
				THISFORM.nstart = RECNO()
			ENDIF
			THISFORM.mygrid.REFRESH()
		ENDIF

		RETURN DODEFAULT(nButton, nShift, nXCoord, nYCoord)
	ENDPROC


	PROCEDURE OLECOMPLETEDRAG
		LPARAMETERS nEffect
		THISFORM.cnt1.shpSelected.VISIBLE=.F.
		=ClipCursor (THISFORM.mclip)
		RETURN DODEFAULT(nEffect)
	ENDPROC


	PROCEDURE OLEGIVEFEEDBACK
		LPARAMETERS nEffect, eMouseCursor
		THISFORM.drawbox()
		NODEFAULT
	ENDPROC


	PROCEDURE OLESTARTDRAG
		LPARAMETERS oDataObject, nEffect

		*** clip mouse to form boundaries
		THISFORM.cliptoform()

		*** activate cell at mouse position
		THISFORM.MakeCellActive()

		*** set height of grid/container if grid shows a "half" row at bottom
		DO WHILE MOD((THISFORM.mygrid.HEIGHT-THISFORM.mygrid.HEADERHEIGHT-2),THISFORM.mygrid.ROWHEIGHT) # 0
			THISFORM.mygrid.HEIGHT = THISFORM.mygrid.HEIGHT - 1
			THISFORM.cnt1.HEIGHT = THISFORM.cnt1.HEIGHT - 1
		ENDDO

		*** set form properties that set dynamicbackcolor based on record number
		THISFORM.nstart=RECNO()
		THISFORM.nend=RECNO()

		RETURN DODEFAULT(oDataObject, nEffect)
	ENDPROC

	ADD OBJECT shpSelected AS SHAPE WITH ;
		OLEDROPMODE = 1, ;
		TOP = 45, ;
		LEFT = 87, ;
		HEIGHT = 17, ;
		WIDTH = 100, ;
		BACKSTYLE = 0, ;
		BORDERSTYLE = 2, ;
		VISIBLE = .F., ;
		BORDERCOLOR = RGB(255,0,0), ;
		NAME = "shpSelected"

ENDDEFINE

*
*-- EndDefine: frmgrid
**************************************************

Category Code Samples Category VFP Controls
( Topic last updated: 2004.12.14 03:27:58 PM )