Как добавить свой класс Header в Grid (Михаил Дроздов

5151

Как добавить свой класс Header в Grid

> Получаю код формы содержащей GRID с несколькими полями.
> Создаю класс, генерирую prg-файл Class Browser-ом.
> Запускаю - синтаксическая ошибка в строке (GRID.COLUMN1.HEADER1.. as HEADER )
> ... и никто помочь не может. Одна надежда на Вас.

Давайте попробуем разобраться, разложив вопрос на следующие пункты:

Как исправить код, созданный Class Browser
Добавление своего класса Header из кода prg-файла
Добавление своего класса Header используя vcx-библиотеку
Хотелось бы добавлять также из кода и в Page-ы
Описание файлов, включённых в Hdrgrd.zip.
Пример кода для VFP 8.0 (или выше), показывающий использование свойств: HeaderClassLibrary и HeaderClass столбца в Grid-е.

Как исправить код, созданный Class Browser.
В начало

Попробуйте изменить код на подобный следующему:

*///////// 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

т.е. просто перенесите инициализацию заголовков/колонок в событие MyForm.Init()

Аналогичный вопрос довольно часто задаётся также в связи с тем, что имеется желание перепрограммировать его событие Click(). И действительно, имеется проблема, поскольку класс Header не может быть добавлен в vcx-библиотеку, по крайней мере официально :-) ... Давайте рассмотрим это дело в двух аспектах:

Добавление своего класса Header из кода prg-файла.
В начало

Добавить свой класс из кода - нет проблем! И чтобы не быть голословным приведу коротенький пример того как это можно сделать.

*//////////////////////// 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

Как видите всё настолько просто, что практически нечего комментировать :-) Разве только нужно сказать, что я воспользовался своей утилитой GenDE (см. на стр. Примеры), чтобы получить исходник класса GridDE :-))...

Добавление своего класса Header используя vcx-библиотеку.
В начало

Выше было сказано, что "класс Header не может быть добавлен в vcx-библиотеку, по крайней мере официально". Давайте обсудим теперь эту проблему, т.е. посмотрим, как же это можно сделать т.с. неофициально :-)

Проблема:
В начало

Определения классов GridDE, SessionDE, MyColumn и MyHeader помещается в prg-файл (HeaderInGrid_p.prg), однако, кроме эстетических соображений это вызывает проблему использования таких классов как DE-классов в формах, и вот почему:

Суть проблемы в том, что метод AnyObj.AddObject() не позволяет создавать экземпляры классов из prg-файлов непосредственно (только из vcx-библиотек совместно с SET CLASSLIB TO ...), в то время как только именно метод AddObject() корректно работает с Private Data Session формы, в отличии от CreateObject()/NewObject() [см. тему "Имею VFP 6.0+SP3 VS6 и сейчас появился класс Session. Не покажете ли пример его использования?" в FAQ на http://vfpdmur.narod.ru/faq/de_r.html]

Возможный путь обхода указанной трудности заключается в том, чтобы поместить класс SessionDE (производный от Session) в vcx-библиотеку. Однако и здесь, сделать это непосредственно не удаётся, т.к. возникает ошибка: Cannot visually modify a class of this type (Error 1978). Последнее справедливо также и для классов MyColumn, MyHeader :-() ...Тем не менее, имеется небольшой трюк, чтобы осуществить это. Ниже объясняются шаги, чтобы сделать это, на примере классе SessionDE из библиотеки GridLib.vcx

Решение:
В начало

создайте новый класс Custom, в vcx-библиотеке, помещённой в какой-нибудь проект
отредактируйте его в Class Designer, подразумевая, что это класс Session
по завершению редактирования откройте vcx-библиотеку как dbf-файл и измените значение в полях Class и BaseClass с custom на session (на column, header в классах MyColumn, MyHeader соответсвенно)
перекомпилируйте проект, с включенным флагом Recompile All Files
если Вам потребуется редактировать таким образом полученный класс, то прямо как есть сделать это непосредственно в Class Designer не удаётся. Однако, выполнив действия, обратные к пункту 3) выше, Вы получаете класс редактируемый из Class Designer. После внесения изменений остаётся только выполнить пункты 3-4 выше.

Замечание:
В начало

Если Вы случайно попытались редактировать нередактируемый класс Session (Column, Header) т.е. получили ошибку Error 1978, лучше закрыть среду VFP и открыть её снова, поскольку такая попытка редактирования приводит к exclusive-захвату файла Вашей библиотеки и никакими силами избавиться от такого захвата не удаётся :-( Надёжным признаком возможности редактирования класса SessionDE в Class Designer является наличие у него иконки класса Custom на закладке Classes в проекте. И наоборот, не пытайтесь открыть на редактирование в Class Designer класс, у которого отсутствует иконка (т.е. производный от Session), это неизбежно приведёт к ошибке Error 1978.

Создание своего класса Column:
В начало

Я был бы не до конца честным по отношению к Вам, если бы не раскрыл одну пикантную подробность :-) Имеется определённая сложность в создании класса, производного от Column. Проблема заключается в том, что он т.с. по определению является контейнером, включающем в себя класс Header. Таким образом, если мы не изловчимся включить свой класс (MyHeader) в создаваемый нами класс, производный от Column, т.е. в точности то, что делает код:

DEFINE CLASS MyColumn AS Column
	ADD OBJECT Header1 AS MyHeader
ENDDEFINE

то мы будем вынуждены во время выполнения, где-то в событии MyColumn.Init() сделать следующее:

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

удаляя вставленный по умолчанию класс Header1 и добавляя вместо него свой класс MyHeader :-( ...Именно так и написан класс MyColumn из GridLib.vcx. Это конечно не шедевр, однако нет почти никаких проблем по его редактированию, ну за исключением тех, что указаны в замечании выше.

Теперь, когда как надеюсь проблема понятна, можно создать и т.с. полноценный класс-контейнер, как производный от Column. Для этого можно поступить следующим образом:

создать новый класс Label назовём его MyLable (шаблон для последующей замены на класс MyHeader)
создать новый класс Container назовём его NewColumn (это будующий наш новый класс, производный от Column)
поместить в класс NewColumn экземпляр класса MyLable, придав ему в качестве имени Header1 (на этом этапе, как вы понимаете, наш класс NewColumn ещё редактируем из Class Designer)
теперь закроем нашу библиотеку, и открыв её снова как dbf-файл, произведём соотвествующие замены, т.е. label, container и MyLable на header, column и MyHeader соответсвенно. Очевидно, что после этого шага наши классы перестанут быть редактируемы из Class Designer.
перекомпилировать проект.

Наконец, чтобы легко можно было изменять используемый класс с MyColumn на NewColumn и контролировать какой же из классов используется я поместил в событие MyForm.Load() следующий код:

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

В заключении хочу посоветовать: прежде чем начать чего-нибудь делать с библиотекой GridLib.vcx, сделайте её резервную копию :-)

Хотелось бы добавлять также из кода и в Page-ы
В начало

Из кода/vcx и следует создавать свой класс MyPageFrame с Page-ами... а уже его и добавлять. :-)

Описание файлов, включённых в Hdrgrd.zip:
В начало

HeaderInGrid_p.prg	- "прямой" код, т.е. определение всех классов одновременно и исполнимый пример
GridLib.vcx	- создана по описанной выше технологии для классов из HeaderInGrid_p.prg
HeaderInGrid_l.prg	- код, использующий классы из библиотеки GridLib.vcx

Загрузить Hdrgrd.zip (17,7KB) (см. также замечание в начале стр. Примеры, относительно медленной скорости загрузки :-()

Пример кода для VFP 8.0 (или выше), показывающий использование свойств: HeaderClassLibrary и HeaderClass столбца в Grid-е.
В начало

На примере класса, производного от Header, показана возможность изменения порядка сортировки по щелчку на заголовке столбца в Grid-е. Загрузить grdhdrcl.zip (12,0KB)

По вопросам, связанным с этим веб-узлом, обращайтесь по адресу: