Problem with Scroll Bars not working in Grid

[grewegreg]

Folks,

I have created a grid with some custom properties and methods. Whenever I drop the grid onto a form or inside another class, the properties and methods of the grid work just fine, except using the scrollbars. Even though the scrollbars are set to 3 (Both), they act as if they are disabled. I can scroll the grid using the arrow, page up or page down keys, but not the scroll bars. Changing the ReadOnly property does not seem to have any affect either.

I have pasted the code below, any suggestions would be greatly appreciated... Thanks in advance.

**************************************************
*-- Class:        base_grid (c:\data\foxpro\base classes\base_classes.vcx)
*-- ParentClass:  grid
*-- BaseClass:    grid
*-- Time Stamp:   05/20/07 04:31:07 PM
*
#INCLUDE "c:\data\foxpro\bin\foxpro.h"
*
DEFINE CLASS base_grid AS grid


	ColumnCount = 5
	DeleteMark = .F.
	HeaderHeight = 30
	Height = 265
	ReadOnly = .T.
	Width = 410
	HighlightBackColor = RGB(0,128,0)
	HighlightStyle = 2
	AllowCellSelection = .F.
	*-- XML Metadata for customizable properties
	_memberdata = [<VFPData><memberdata name="tooltiptext" type="Property" favorites="True"/><memberdata name="statusbartext" type="Property" favorites="True"/></VFPData>]
	ro_display_sub_form = .F.
	rc_parenttable = "THISFORM.rc_MasterAlias"
	Name = "base_grid"
	Column1.Alignment = 2
	Column1.ReadOnly = .F.
	Column1.Name = "Column1"
	Column2.Alignment = 2
	Column2.ReadOnly = .T.
	Column2.Name = "Column2"
	Column3.Alignment = 2
	Column3.ReadOnly = .T.
	Column3.Name = "Column3"
	Column4.Alignment = 2
	Column4.ReadOnly = .T.
	Column4.Name = "Column4"
	Column5.Alignment = 2
	Column5.ReadOnly = .T.
	Column5.Name = "Column5"


	ADD OBJECT base_grid.column1.header1 AS header WITH ;
		Alignment = 2, ;
		Caption = "Header1", ;
		Name = "Header1"


	ADD OBJECT base_grid.column1.text1 AS textbox WITH ;
		Alignment = 2, ;
		BorderStyle = 0, ;
		Margin = 0, ;
		ReadOnly = .F., ;
		ForeColor = RGB(0,0,0), ;
		BackColor = RGB(255,255,255), ;
		Name = "Text1"


	ADD OBJECT base_grid.column2.header1 AS header WITH ;
		Alignment = 2, ;
		Caption = "Header1", ;
		Name = "Header1"


	ADD OBJECT base_grid.column2.text1 AS textbox WITH ;
		Alignment = 2, ;
		BorderStyle = 0, ;
		Margin = 0, ;
		ReadOnly = .T., ;
		ForeColor = RGB(0,0,0), ;
		BackColor = RGB(255,255,255), ;
		Name = "Text1"


	ADD OBJECT base_grid.column3.header1 AS header WITH ;
		Alignment = 2, ;
		Caption = "Header1", ;
		Name = "Header1"


	ADD OBJECT base_grid.column3.text1 AS textbox WITH ;
		Alignment = 2, ;
		BorderStyle = 0, ;
		Margin = 0, ;
		ReadOnly = .T., ;
		ForeColor = RGB(0,0,0), ;
		BackColor = RGB(255,255,255), ;
		Name = "Text1"


	ADD OBJECT base_grid.column4.header1 AS header WITH ;
		Alignment = 2, ;
		Caption = "Header1", ;
		Name = "Header1"


	ADD OBJECT base_grid.column4.text1 AS textbox WITH ;
		Alignment = 2, ;
		BorderStyle = 0, ;
		Margin = 0, ;
		ReadOnly = .T., ;
		ForeColor = RGB(0,0,0), ;
		BackColor = RGB(255,255,255), ;
		Name = "Text1"


	ADD OBJECT base_grid.column5.header1 AS header WITH ;
		Alignment = 2, ;
		Caption = "Header1", ;
		Name = "Header1"


	ADD OBJECT base_grid.column5.text1 AS textbox WITH ;
		Alignment = 2, ;
		BorderStyle = 0, ;
		Margin = 0, ;
		ForeColor = RGB(0,0,0), ;
		BackColor = RGB(255,255,255), ;
		Name = "Text1"


	PROCEDURE m_sort_grid
		LOCAL lcSafety AS Character, lcField AS Character, lcString AS Character, ;
			lcAlias AS Character, loColumn AS Object, nView_Out AS Integer, ;
			nWhere_Out AS Integer, nRelRow_Out AS Integer, nRelCol_Out AS Integer, ;
			nXCoord_In AS Integer,  nYCoord_In AS Integer, lnBuffering, lcSortOrder AS Character, ;
			i as Integer, loHeader AS Object    

		nXCoord_In = MCOL(WONTOP(),3)
		nYCoord_In = MROW(WONTOP(),3)

		STORE 0 TO nWhere_Out, nRelRow_Out, nRelCol_Out, nView_Out
		 
		IF THIS.GridHitTest(nXCoord_In, nYCoord_In, @nWhere_Out, @nRelRow_Out, @nRelCol_Out)
			loColumn = "THIS.Column" + ALLTRIM(STR(nRelCol_Out)) 
			loColumn = EVALUATE(loColumn)

			lcAlias = UPPER(THIS.RecordSource)
			lcString = UPPER(loColumn.ControlSource)
			lcField = STRTRAN(lcString, lcAlias + ".", "")
			lcString = EVALUATE(lcString)

			SELECT(lcAlias)
			lnBuffering = CURSORGETPROP("Buffering", lcAlias)
			IF CURSORSETPROP("Buffering", 3, lcAlias)
				lcSafety = SET('SAFETY')
				SET SAFETY OFF
				*
				DO CASE 
				 CASE VARTYPE(lcString) = "C" 
				 	lcSortOrder = "INDEX ON ALLTRIM(" + lcField + ")" 
				 CASE VARTYPE(lcString) = "N" OR VARTYPE(lcString) = "Y" OR VARTYPE(lcString) = "D" ;
				 		OR VARTYPE(lcString) = "T" OR VARTYPE(lcString) = "L" 
				 	lcSortOrder = "INDEX ON " + lcField
				 CASE VARTYPE(lcString) = "Q" OR VARTYPE(lcString) = "G" OR VARTYPE(lcString) = "O" ;
				 		OR VARTYPE(lcString) = "X" OR VARTYPE(lcString) = "U" 
				 	lcSortOrder = loColumn.Header1.Caption
				ENDCASE
				*
				*!*	Set every column, except the one selected, to no picture and no sort
				*
				FOR i = 1 TO THIS.ColumnCount
					IF i <> nRelCol_Out 
						loHeader = "THIS.Column" + ALLTRIM(STR(i)) 
						loHeader = EVALUATE(loHeader)
						loHeader.Header1.Picture = ''
						loHeader.Header1.rn_Sorted = 0
					ENDIF	&&& i <> nRelCol_Out 
				ENDFOR	&&& i = 1 TO THIS.ColumnCount
				*
				IF loColumn.Header1.rn_Sorted = 0 OR loColumn.Header1.rn_Sorted = 2
				 	&&& Nothing Set, make Ascending OR Descending, change to Ascending
					loColumn.Header1.Picture = "ARW08UP.ICO"
					lcSortOrder = lcSortOrder + " TAG Key ASCENDING"
					loColumn.Header1.rn_Sorted = 1
				ELSE
				 	&&& Ascending, change to Descending
					loColumn.Header1.Picture = "ARW08DN.ICO"
					lcSortOrder = lcSortOrder + " TAG Key DESCENDING"
					loColumn.Header1.rn_Sorted = 2
				ENDIF	&&& loColumn.Header1.rn_Sorted = 0 OR loColumn.Header1.rn_Sorted = 2
				*
				IF LEFT(lcSortOrder,5) = "INDEX"
					&lcSortOrder
				ELSE
					=MESSAGEBOX('I am sorry, but I can not sort this display by the field type "' + ;
						ALLTRIM(lcSortOrder) + '", please select a different column!', 0, "Problem Sorting Display...")
				ENDIF	&&& LEFT(lcSortOrder,5) = "INDEX"
				*
				GO TOP
				SET SAFETY &lcSafety
				=CURSORSETPROP("Buffering", lnBuffering, lcAlias)
			ENDIF

			THIS.Refresh(.T.)
			SELECT(THISFORM.rc_MasterAlias)
		ELSE
		ENDIF
	ENDPROC


	PROCEDURE m_get_backcolor
		LPARAMETERS pcCheckColor

		STORE .F. TO THIS.HighlightRow, THIS.Highlight  

		DO CASE
		*!*	 CASE RECNO(THIS.RecordSource) = THISFORM.MasterId
		*!*	    STORE THISFORM.BackColor TO pcCheckColor
		*!*	           &&... highlight colour RGB(...)
		*!*	    RETURN &pcCheckColor
		 CASE pcCheckColor = '   '
		    RETURN RGB(255,0,255)    &&... white - no category
		 OTHERWISE
		    STORE ALLTRIM(pcCheckColor) TO pcCheckColor
		           &&... colour code from record
		   RETURN &pcCheckColor
		ENDCASE
	ENDPROC


	PROCEDURE DblClick
		LPARAMETERS plAdd, plMasterId

		LOCAL loColumn AS Object, loFormName AS Object, lnMasterId AS Integer
		*
		IF !EMPTY(THIS.ro_Display_Sub_Form)
			IF VARTYPE(plAdd) = "L" AND plAdd	&&& Add
				IF EMPTY(plMasterId)
					lnMasterId = THISFORM.txtMasterId.Value
				ELSE
					lnMasterId = plMasterId
				ENDIF	&&& EMPTY(plMasterId)
			ELSE	&&& Edit
				SELECT(THIS.RecordSource)
				lnMasterId = MasterId
				SELECT(THISFORM.rc_MasterAlias)
			ENDIF
			*
			loFormName = CREATEOBJECT(THIS.ro_Display_Sub_Form, THISFORM, plAdd, lnMasterId)	&&& THISFORM.DataSessionId)
			IF VARTYPE(loFormName) = "O"
				loFormName.Show()
			ENDIF
		ELSE
			THIS.Parent.cmdEdit.Click()
		ENDIF
	ENDPROC


	PROCEDURE Refresh
		LPARAMETERS llRequery

		IF TXNLEVEL() = 0 AND !llRequery
			REQUERY( THIS.RecordSource )
		ENDIF
		*
		FOR EACH loColumn IN THIS.Columns
			loColumn.Width = VAL(loColumn.Tag)
		ENDFOR
	ENDPROC


	PROCEDURE Init
		LOCAL loColumn AS Object, loControl AS Object

		FOR EACH loColumn IN THIS.Columns
			loColumn.Alignment = 2
			loColumn.Tag = ALLTRIM(STR(loColumn.Width))
			IF !EMPTY(loColumn.Comment)
				STORE loColumn.Comment TO loColumn.Header1.Caption
			ENDIF
			*
			FOR EACH loControl IN loColumn.Controls
				DO CASE
				 CASE LOWER( loControl.BaseClass ) = 'textbox'
		    		BINDEVENT( loControl, 'DblClick', THIS, 'DblClick' )
					IF loColumn.Comment = 'LEFT'
						loColumn.Alignment = 0
					ELSE
						loControl.Alignment = 2
					ENDIF
				 CASE LOWER( loControl.BaseClass ) = 'header'
					BINDEVENT( loControl, 'Click', THIS, 'm_Sort_Grid')
					loControl.Alignment = 2
					loControl.AddProperty("rn_Sorted", 0)
				 OTHERWISE
				ENDCASE
			ENDFOR	&&& EACH loControl IN loColumn.Controls
		ENDFOR	&&& EACH loColumn IN THIS.Columns
	ENDPROC


	PROCEDURE text1.DblClick
		THIS.Parent.Parent.m_DIsplay_sub_forms()
	ENDPROC


ENDDEFINE
*
*-- EndDefine: base_grid
**************************************************

Greg Grewe
Diamond Consulting, LLC

http://www.diamondconsults.com

 

[dgrewe]

Greg,
Since you have the Read Only set on the Columns in the grid you want access to,
Have you tried to make the GRID properties of
ReadOnly = .F.
AllowCellSelection = .T.

David W. Grewe Dave

 

[Imaginecorp]

Greg:
a quick look at your code, it seems like the problem could be in the "m_sort_grid" method. You are doing a GridHitTest() without a specific location for the mouse cursor to be in. It would seem to me when when the scroll bar is clicked the default action is not taking place. Would it not be better to do a sort only when the header is clicked...to test run the method Only when the header is clicked... due to time constraints I have not tested your code

 

[Imaginecorp]

sorry just saw the Bindevent() in the Init()...

 

[grewegreg]

Thanks Dave, it does not seem to matter. I have tried changing both of those settings and several others, no avail. How are you?

Thanks Imaginecorp. If you have any other ideas, please let m e know. Have a good week.


Greg Grewe
Diamond Consulting, LLC

http://www.diamondconsults.com

 

[Imaginecorp]

Tested your code, on a regular grid with "m_sort_grid" as a method on the form and your code (snippets of it) worked perfect, including the scroll bars... I dont think its your code...I know you are making this grid class totally independent, there are a few things I would change just to simplify...In short, no idea here as to why the scroll bars are not doing what they are supposed to...

 

[dgrewe]

Greg,
Over the weekend, I replaced the Base_Grid class above into the copy of the Base_Classes Library I got from you 3 months ago.

Made a quick form from the Base_Form (without Toolbar) class in the library and this new grid with the ZipCode table.

It worked, Scroll bars and all.


David W. Grewe Dave

 

[grewegreg]

Guys, I think I found the problem. I was using a CURSOR as the RecordSource. When I would simply recreate the CURSOR, the scroll bars would not work. If I change the RecordSource to blank, run a new SELECT statement to recreate the CURSOR, recreate the grid, restore the RecordSource, then the scroll bars work just fine. If I just use the cursor and not rebuild it, the scrollbars worked fine also.

I appreciate the help.

Imaginecorp, you said;

I know you are making this grid class totally independent, there are a few things I would change just to simplify...

Can you let me know what those would be?



Greg Grewe
Diamond Consulting, LLC

http://www.diamondconsults.com

 

[Imaginecorp]

Glad you got it solved….

Can you let me know what those would be?

Though I see what you are trying to do, I am a little weary of creating an index when the header is clicked. Seems to me this may slow things down if the table is massive. Rather I would create the indexes in advance,
To set the order to Ascending or descending, just change any existing index to it with a set order to tag Ascending / Descending. They do not have to be specifically created.
To select the correct index when the header is clicked, I would use ATAGINFO(). Column 3 of the array gives you the Field name. You could do an ASCAN() to match the column control source and set the appropriate index.

You have limited this grid to 5 columns: what happens when you need only 3? Sure you could write code to make the 2 columns invisible etc, Why not create the columns in design mode when the grid is placed on a form.

Just my thoughts…