How add the own class Header in Grid (Michael Drozdov

5151

How add the own class Header in Grid

> I receive a code of the form containing GRID with several fields.
> I create a class and receive PRG-file, generated by Class Browser.
> On compiling receive syntactical error on line (GRID.COLUMN1.HEADER1.. as HEADER )
> ... аnd no anybody to help me. One hope on you.

Let's try to understand, by decomposing this problem on the following items:

How to correct a code, created by Class Browser
Adding the class Header from a code of the prg-file
Adding the class Header by using classes in vcx-library
It would be desirable to add also from a code into my Pages
Contents Hdrgrd.zip
Example of code for VFP 8.0 (or late), showing use of properties: HeaderClassLibrary and HeaderClass for column in Grid

How to correct a code, created by Class Browser.
Go top

Try to change a code on the similar following:

*///////// any.prg for VFP 6.0+SP3 or later
RELEASE oFrm
PUBLIC oFrm
oFrm = CreateObject('form1')
IF VARTYPE(oFrm) # 'O'
	RELEASE oFrm
	RETURN .F.
ENDIF
oFrm.Show()

DEFINE CLASS form1 AS form
	Top = 0
	Left = 0
	Height = 212
	Width = 218
	DoCreate = .T.
	Caption = "Form1"
	Name = "Form1"
	DataSession = 2

	ADD OBJECT grdsetup AS grid WITH ;
		ColumnCount = 2, ;
		Height = 200, ;
		Left = 12, ;
		RecordSource = "setup", ;
		RecordSourceType = 1, ;
		Top = 0, ;
		Width = 192, ;
		Name = "grdSetup", ;
		Column1.ControlSource = "setup.key_name", ;
		Column1.Name = "Column1", ;
		Column2.ControlSource = "setup.value", ;
		Column2.Name = "Column2"

	PROCEDURE Load
		ThisForm.AddObject('oSE', 'SessionDE', 'grdwithcolDE')
		IF TYPE('ThisForm.oSE') # 'O' OR ISNULL(ThisForm.oSE)
			RETURN .F.
		ENDIF
	ENDPROC

	PROCEDURE Init()
		WITH ThisForm.grdsetup.Column1.header1
			.Caption = "key_name"
		ENDWITH
		WITH ThisForm.grdsetup.Column2.header1
			.Caption = "value"
		ENDWITH
	ENDPROC

ENDDEFINE

DEFINE CLASS grdwithcolDE AS DataEnvironment
	name = "Dataenvironment"

	ADD OBJECT Cursor1 AS Cursor WITH ;
		name = "Cursor1", ;
		alias = "setup", ;
		cursorsource = "setup", ;
		database = HOME(2)+"tastrade\data\tastrade.dbc"
ENDDEFINE

DEFINE CLASS SessionDE As Session
	DataSession = 2
	Name = "SessionDE"
	oDE = NULL

	PROTECTED FUNCTION CreateDE(tcClassNameDE)
		IF VARTYPE(tcClassNameDE) # 'C' OR EMPTY(tcClassNameDE)
			RETURN .F.
		ENDIF
		WITH This
			IF .DataSession <> 1
				SET DATASESSION TO .DataSessionId
				SET DELETED ON
				SET MULTILOCKS ON
				SET EXCLUSIVE OFF
			ENDIF
			.oDE = NewObject(tcClassNameDE)
			IF VARTYPE(.oDE) = 'O'
				.oDE.OpenTables()
			ELSE
				RETURN .F.
			ENDIF
		ENDWITH
	ENDFUNC

	PROCEDURE Init(tcClassNameDE)
		RETURN This.CreateDE(tcClassNameDE)
	ENDPROC

	PROCEDURE Destroy()
		This.oDE = NULL
	ENDPROC

ENDDEFINE
*///////// end of any.prg

i.e. simply transfer initialization of headers/columns to an event MyForm.Init()

Similar question frequently asked because there is a desire to reprogram its an event Click(). And it's true that this problem exist. As the class Header can not be added in vcx-library, at least officially :-) Let's consider this problem in two aspects:

Adding the class Header from a code of the prg-file.
Go top

However, from a code - there are no problems! ...And to be not unfounded I shall bring a short example that as it can be made.

*//////////////////////// any.prg for VFP 6.0+SP3 or later
RELEASE oFrm
PUBLIC oFrm
oFrm = CreateObject('form1')
IF VARTYPE(oFrm) # 'O'
	RELEASE oFrm
	RETURN .F.
ENDIF
oFrm.Show()	

DEFINE CLASS form1 AS form
	Top = 0
	Left = 0
	Height = 212
	Width = 218
	DoCreate = .T.
	Caption = "Form1"
	Name = "Form1"
	DataSession = 2

	PROCEDURE Load
		*
		*-- SessionDE
		ThisForm.AddObject('oSE', 'SessionDE', 'GridDE')
		IF TYPE('ThisForm.oSE') # 'O' OR ISNULL(ThisForm.oSE)
			RETURN .F.
		ENDIF
		*
		*-- Grid
		ThisForm.AddObject('oGrid', 'mygrid')
		IF TYPE('ThisForm.oGrid') # 'O' OR ISNULL(ThisForm.oGrid)
			RETURN .F.
		ENDIF
		*
		*-- Columns
		LOCAL lnCol, lcCurObj, lcAlias, lcSetComp
		lcSetComp = SET('COMPATIBLE')
		IF INLIST(lcSetComp, 'ON', 'DB4')
			SET COMPATIBLE OFF
		ENDIF 
		lcAlias = PROPER(ThisForm.oSE.oDE.Cursor1.alias)
		WITH ThisForm.oGrid
			.RecordSource = lcAlias
			FOR lnCol = 1 TO FCOUNT(lcAlias)
				lcCurObj = 'Column'+LTRIM(STR(lnCol))
				.AddObject(lcCurObj, 'MyColumn')
				IF TYPE('ThisForm.oGrid.'+lcCurObj) # 'O'
					RETURN .F.
				ENDIF
				lcCaption = PROPER(FIELD(lnCol, lcAlias))
				lcField = lcAlias+'.'+lcCaption
				WITH .Columns(lnCol)
					.Header1.Caption = lcCaption
					.ControlSource = lcField
					.Width = FSIZE(lcCaption, lcAlias)*7 
					.Text1.Visible = .T.
					.Visible = .T.
				ENDWITH
			ENDFOR
			.Visible = .T.
		ENDWITH
		IF !(lcSetComp == SET('COMPATIBLE'))
			SET COMPATIBLE &lcSetComp
		ENDIF
	ENDPROC

	PROCEDURE Init
		WITH This
			.Width = 2*SYSMETRIC(21)/3
			.Height = 2*SYSMETRIC(22)/3
			.Resize()
		ENDWITH	
	ENDPROC

	PROCEDURE Resize
		WITH ThisForm.oGrid
			LOCAL lnWs, lnHs
			lnWs = .Left+.Left
			lnHs = .Top+.Top
			IF ThisForm.Width > lnWs
				.Width = ThisForm.Width - lnWs
			ENDIF
			IF 	ThisForm.Height > lnHs
				.Height = ThisForm.Height - lnHs
			ENDIF
		ENDWITH
	ENDPROC
ENDDEFINE

DEFINE CLASS MyHeader AS Header
	PROCEDURE Click()
		WITH This.Parent.Parent
			.ChangeOrder(.ActiveColumn)
		ENDWITH	
	ENDPROC
ENDDEFINE 

DEFINE CLASS MyColumn AS Column
	Width = 30
 	ADD OBJECT Header1 AS MyHeader
ENDDEFINE

DEFINE CLASS MyGrid AS grid
	ColumnCount = 0
	DeleteMark = .F.
	Height = 200
	RecordSourceType = 1
	Width = 192
	Name = "MyGrid"

	PROCEDURE ChangeOrder
		LPARAMETERS tnCol
		IF EMPTY(tnCol)
			RETURN .F.
		ENDIF	
		LOCAL lcAlias, lcCdx, lnRecNo, lcSource;
			,lcField, lnPos, lnTag, lbFound
		WITH This
			*
			*-- Check CDX-file
			lcAlias = .RecordSource
			lcCdx = CDX(1, lcAlias)
			IF EMPTY(lcCdx)
				WAIT WINDOW 'CDX file for '+lcAlias;
					+' not found.' NOWAIT
				RETURN .F.
			ENDIF
			IF EMPTY(TAG(lcCdx, 1, lcAlias))
				RETURN .F.
			ENDIF	 
			*
			*-- Find index for column
			lcSource = .Columns(tnCol).ControlSource
			lnPos = ATC('.', lcSource)
			lcField = UPPER(SUBSTR(lcSource, lnPos+1))
			IF LENC(lcField) > 10
				lcField = LEFTC(lcField, 10)
			ENDIF
			FOR lnTag = 1 TO TAGCOUNT(lcCdx, lcAlias)
				IF TAG(lcCdx, lnTag, lcAlias) = lcField
					lbFound = .T.
					EXIT
				ENDIF	
			ENDFOR
			IF !lbFound
				WAIT WINDOW 'Tag: ';
					+lcField+' not found.' NOWAIT
				RETURN .F.
			ENDIF
			*
			*-- Change order
			lnRecNo = IIF(!EOF(), RECNO(), 0)
			SET ORDER TO TAG (lcField) ;
				IN (lcAlias)
			.ActivateCell(1, tnCol)
			IF lnRecNo # 0
			    GO (lnRecNo)
			ELSE
			    GO TOP 
			ENDIF
			.Refresh()
		ENDWITH
	ENDPROC
ENDDEFINE

DEFINE CLASS GridDE AS DataEnvironment
	name = "Dataenvironment"

	ADD OBJECT Cursor1 AS Cursor WITH ;
		name = "Cursor1", ;
		alias = "customer", ;
		cursorsource = "customer", ;
		database = HOME(2);
			+"tastrade\data\tastrade.dbc"
ENDDEFINE

DEFINE CLASS SessionDE As Session
	DataSession = 2
	Name = "SessionDE"
	oDE = NULL
	
	PROTECTED FUNCTION CreateDE(tcClassNameDE)
		IF VARTYPE(tcClassNameDE) # 'C' ;
		 		OR EMPTY(tcClassNameDE)
			RETURN .F.
		ENDIF	
		WITH This
			IF .DataSession <> 1
				SET DATASESSION TO .DataSessionId
				SET DELETED ON
				SET MULTILOCKS ON
				SET EXCLUSIVE OFF
			ENDIF
			.oDE = NewObject(tcClassNameDE)
			IF VARTYPE(.oDE) = 'O'	
				.oDE.OpenTables()
			ELSE
				RETURN .F.	
			ENDIF	
		ENDWITH	
	ENDFUNC

	PROCEDURE Init(tcClassNameDE)
		RETURN This.CreateDE(tcClassNameDE)
	ENDPROC
	
	PROCEDURE Destroy()
		This.oDE = NULL
	ENDPROC
ENDDEFINE
*//////////////////////// end of any.prg

As you can see all is so simple, that practically there is nothing to make comments. : -) Unless only it is necessary to tell, that I have taken advantage of the GenDE utility (see on page Examples) to receive source code of the class GridDE :-))...

Adding the class Header by using classes in vcx-library.
Go top

As was told above, that "the class Header can not be added in vcx-library, at least officially". Let's discuss now this problem, i.e. we shall look, as it can be made that is to say informally

Problem:
Go top

Allocation classes MyColumn, MyHeader, SessionDE in vcx-library is not typical from the point of view of Microsoft, so they have written VFP that the use only from a code (see definitions of these classes in HeaderInGrid_p.prg), however on my sight it's rather severe restriction, ... and I have located these classes in library that is to say by "handles", the apart from is clean of aesthetic reasons, there is also a certain problem under discussion below.

The main thing of a problem that a method AnyObj.AddObject() does not allow to create instances of classes from prg-files immediately (only from vcx-libraries together with SET CLASSLIB TO...), while only just the method AddObject() correctly works with Private Data Session of the form, as against CreateObject()/NewObject() [see theme "I have VFP 6.0+SP3 VS6 and now class Session has appeared. Not whether will show an example of its use?" in FAQ on http://vfpdmur.narod.ru/faq/de_e.html]

The possible way to overcome of the indicated difficulty consists in locating a class SessionDE (derivative from Session) in vcx-library. However here again, to make it immediately it is not possible, because there is an error: Cannot visually modify a class of this type (Error 1978) (it have place as well for classes: MyColumn, MyHeader :-(). Nevertheless, there is a small trick to realize it. Pitches below are explained how to make it, on an example Class SessionDE from library GridLib.vcx

Solution:
Go top

Create a new class Custom in your classlib, including in any project
Edit it in Class Designer, implying that it is a class Session
On completion of editing open vcx-library as the dbf-file and change values in fields Class and BaseClass with custom on Session (Column, Header, for classes MyColumn and MyHeader accordingly)
Recompile the project, with the included flag Recompile All Files
If you will need to edit thus obtained classes directly "as is" to make it immediately in Class Designer it is not possible. However, by inverse action in item 3) is higher, you receive classes edited from Class Designer. After modification it is necessary only to execute items 3-4 above.

Warning:
Go top

If you accidentally have tried to edit a not edited class Session (Column, Header) i.e. have received Error 1978, it is better to close VFP environment and to open it again, as such attempt of editing results to exclusive-grab of the file of your library and any forces to be closed of such grab is not possible :-( The reliable indication of a possibility of editing of a class SessionDE (MyColumn, MyHeader) in Class Designer is the availability is the icon of a class Custom on a tab Classes in the project. And on the contrary, do not try to open on editing in Class Designer a class, which does not have icon (i.e. derivative from Session), it inevitably will reduce Error 1978.

Creation of the own class Column:
Go top

I would be not up to an extremity honest man in relation to you, if has not uncovered one piquant detail :-) There is a certain complexity in creation of a class, derivative from Column. The problem consists on definition the container including the class Header. Thus, if we not contrive to include the class (MyHeader) in a class created as derivative from Column, i.e. exactly that makes a code:

DEFINE CLASS MyColumn AS Column
	ADD OBJECT Header1 AS MyHeader
ENDDEFINE

that we shall be do, somewhere in an event MyColumn.Init() in runtime, to make the following:

WITH This
	IF TYPE('This.Header1') = 'O'
		.RemoveObject('Header1')
	ENDIF
	.AddObject('Header1', 'MyHeader')
ENDWITH

Deleting a Header1 class, inserted by default, and adding instead of it the own class MyHeader :-( ...Just so the class MyColumn from GridLib.vcx is written. It certainly not a masterpiece, however are no any problems with editing it, but an elemination that are indicated in the warning above.

Now, when as I hope a problem be clear, it is possible to create and rigorous class - container, as derivative from Column. For this purpose it is possible to act as follows:

create a new class Label shall name it of MyLable (template for a consequent replacement on a class MyHeader)
create a new class Container shall name it of NewColumn (it is future our new class, derivatived from Column)
locate in a class NewColumn the instance of a class MyLable, by adding it as the Header1 name (at this stage, as you understand, our class NewColumn still is edited from Class Designer)
now we shall close our library, and by opening it again as the dbf-file, we shall make appropriate replacements, i.e. label, container and MyLable on header, column and MyHeader accordingly. It is obvious, that after that pitch our classes will cease to be edited from Class Designer.
recompile the project.

At last, that it was easily possible to change a used class with MyColumn on NewColumn and to inspect with what from classes I am used, has located in an event MyForm.Load() following code:

*
*-- What class column we are used now?
#DEFINE UDCHEADER .F.
#IF UDCHEADER
 #DEFINE CLS_COLUMN 'NewColumn' &&- includes the user defined class Header
#ELSE
 #DEFINE CLS_COLUMN 'MyColumn'  &&- includes the default class Header
#ENDIF
WAIT WINDOW 'Used: '+CLS_COLUMN NOWAIT

In the conclusion I want to advise: before to begin something to do with library GridLib.vcx, make backup copy for it :-)

It would be desirable to add also from a code into my Pages
Go top

It's necessary from a code/vcx to create the own class MyPageFrame with Pages... and already it and to add. :-)

Contents Hdrgrd.zip:
Go top

To check up said above you can on the following example containing files:

HeaderInGrid_p.prg	- "direct" code, i.e. all definitions of classes in the prg-file as well as executable example
GridLib.vcx	- is created on a just technique above for classes from HeaderInGrid_p.prg
HeaderInGrid_l.prg	- example using of classes from library GridLib.vcx

Download Hdrgrd.zip (17,7KB) (see also note on top p. Examples, about slow loading :-()

Example of code for VFP 8.0 (or late), showing use of properties: HeaderClassLibrary and HeaderClass for column in Grid
Go top

Download grdhdrcl.zip (12,0KB) - On an example of the class, derivative from Header, the opportunity of change of the order of sorting on click on heading of a column in Grid is shown.

In all respects to this web-site, visit page: