Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
An easy one for VFP gurus - how to create a class for he
Message
General information
Forum:
Visual FoxPro
Category:
Classes - VCX
Miscellaneous
Thread ID:
00653357
Message ID:
00653360
Views:
26
>I love to know how can I make a class for the header of columns in a grid.
>
>I have a grid class that will automatically add columns and resize the columns base on the fields in the recordsource property.
>
>My Big question is i want to create a header class that has
>a method on the header to sort the table when it is clicked. I will the add the header class to my grid class
********************************************************************
*  Description.......: myHeader.Definition
*  Calling Samples...:
*  Parameter List....: tcCaption
*  Ideas by..........: Cetin Basoz & David Frankenbach & Vlad Grynchyshyn
*  Modified by.......: Nadya Nosonovsky 09/14/2001 10:50:09 AM
********************************************************************
define class MyHeader as header
	mcArrowName = ""    && name of the arrow used for all headers of the grid
	mlAscending = .f.   && flag for sort order
	mlColumnMoved = .f. && flag indicating column was moved
	mnColumnOrder = 0   && original column order
	mlColumnSized = .f. && flag indicating column was resized
	mnColumnWidth = 0   && original size of column
	nOriginalForeColor = 0  && original ForeColor
	nCurForeColor = 0  && current ForeColor
	nForeColorAsc =  16711935 && Fore Color, when the column is in ASC order
	nForeColorDesc = 8388863   && Fore Color, when the column is in DESC order
	nNormalForeColor = 0 && Black
	nActiveColumnForeColor = 16777215 && White
	lDontChangeOthers = .f. && Flag, which tells to not change other headers forecolor
	lSorted = .f. && Logical property, what this column was sorted
	cTagName = '' && Tag Name, which should be used for sorting, if not specified, use the column source instead
	statusbartext = "" && Status Bar Text for the Header
	tooltiptext = "" && Tool Tip Text property for the Header
	lFirstTime = .t. && If ToolTipText was already assigned

	procedure init
	lparameters tcCaption
	local ix, lcProperty
	with this
		if vartype(m.tcCaption) # "C" ;
				or empty(m.tcCaption)
			tcCaption = .caption
		endif
		.caption = m.tcCaption
		.alignment = 2
		.nOriginalForeColor=.forecolor
		.nCurForeColor = .forecolor
		if !pemstatus(.parent.parent,"nCurOrderedColumnIndex",5)
			.parent.parent.addproperty("nCurOrderedColumnIndex",0)
		endif
		if !pemstatus(.parent.parent,"nCurActiveColumnIndex",5)
			.parent.parent.addproperty("nCurActiveColumnIndex",0)
		endif
	endwith
endproc

	procedure ForeColor_assign
	lparameters vNewVal
*To do: Modify this routine for the Assign method
	with this
		if m.vNewVal <> .forecolor && Color is supposed to change
			if inlist(m.vNewVal, .nForeColorAsc, .nForeColorDesc)
				.parent.parent.nCurOrderedColumnIndex=.GetColumnIndex()
			else
				.nCurForeColor= m.vNewVal
				.nOriginalForeColor = m.vNewVal
				.parent.parent.nCurActiveColumnIndex=.GetColumnIndex()
			endif
			.forecolor = m.vNewVal
		endif
	endwith

*!*		procedure ToolTipText_assign
*!*		lparameters vNewVal
*!*	*To do: Modify this routine for the Assign method
*!*			with this
*!*	*!*			if .lFirstTime
*!*	*!*	&& Add shape to a parent of the grid, if it does not exist already
*!*	*!*				if not pemstatus(.parent.parent.parent,'shape'+.parent.parent.name,5)
*!*	*!*					.parent.parent.parent.newobject('shape'+.parent.parent.name,'shape')
*!*	*!*					with evaluate('this.parent.parent.parent.shape'+this.parent.parent.name)
*!*	*!*						.height = this.parent.parent.headerheight
*!*	*!*						.width = this.parent.parent.width
*!*	*!*						.top =  this.parent.parent.top
*!*	*!*						.left = this.parent.parent.left
*!*	*!*						.backstyle = 0
*!*	*!*						.tooltiptext = m.vNewVal
*!*	*!*						.visible = .t.
*!*	*!*						.zorder(1) && put it behind the header
*!*	*!*					endwith
*!*	*!*				endif
*!*	*!*			endif
*!*			.tooltiptext = m.vNewVal
*!*			.lFirstTime = .f. && Now it's not the first time
*!*		endwith

	procedure GetColumnIndex
	local lnI, lnIndex
	lnIndex=0
	with this.parent
		for lnI=1 to .parent.columncount
			if .parent.columns[m.lnI].columnorder=.columnorder
				lnIndex=m.lnI
				exit
			endif
		next
	endwith
	return m.lnIndex
endproc

	procedure Order_Highlight
	lparameter toColumn
	if vartype(toColumn)<>'O'
		local lnOldIndex, lnIndex, loColumn, lnActiveColumn
		lnActiveColumn = this.parent.parent.activecolumn
		for each loColumn in this.parent.parent.columns
				if type('loColumn.Header1.caption')='C' ;
						and pemstatus(loColumn.Header1,'nOriginalForeColor',5)
					loColumn.Header1.lSorted = .f.	
					if loColumn.columnorder <> m.lnActiveColumn or this.lDontChangeOthers
						loColumn.Header1.forecolor = this.nNormalForeColor
					else
						loColumn.Header1.forecolor = this.nActiveColumnForeColor
					endif
				endif
			next		
	endif
*!*		lnOldIndex = this.parent.parent.nCurOrderedColumnIndex
*!*		with this.parent.parent
*!*			if m.lnOldIndex > 0
*!*			    wait window time 2 transform(m.lnOldIndex)
*!*				.columns[m.lnOldIndex].Header1.forecolor= ;
*!*					.columns[m.lnOldIndex].Header1.nOriginalForeColor
*!*			endif
*!*		endwith
	with this
	    .lSorted = .t.
		if descending()
			.forecolor = .nForeColorDesc && Red
		else
			.forecolor = .nForeColorAsc
		endif
	endwith
endproc

	procedure click
	local nTempCurRec, lcTagName
	with this
		if ! .mlColumnMoved and ! .mlColumnSized
* sortable column that was clicked
			.mlAscending = ! .mlAscending
			thisform.lockscreen = .t.
			lcTagName=iif(!empty(.cTagName),.cTagName,justext(.parent.controlsource))
			select (.parent.parent.recordsource)
			if tagno(m.lcTagName)> 0
				nTempCurRec = recno(.parent.parent.recordsource)
				if .mlAscending
					set order to tag (m.lcTagName) ;
						in (.parent.parent.recordsource) ascending
				else
					set order to tag (m.lcTagName) ;
						in (.parent.parent.recordsource) descending
				endif
				.Order_Highlight() && Show color
				.parent.parent.refresh()
				if type('thisform.navstand.name')='C'
					thisform.navstand.lstOrders.refresh()
					thisform.navstand.navUpdate()
				endif
				if between(m.nTempCurRec,1,reccount(.parent.parent.recordsource))
					go m.nTempCurRec in (.parent.parent.recordsource)
				endif
			endif
			thisform.lockscreen = .f.
		endif
	endwith
endproc

	procedure mousemove && Mouse moves over control
	lparameters nButton, nShift, nXCoord, nYCoord
	with this
		set message to .statusbartext
&&evaluate('this.parent.parent.parent.shape'+this.parent.parent.name)
		.parent.parent.tooltiptext = .tooltiptext
		.parent.parent.statusbartext = .statusbartext
*    .MouseDownToolTip(nButton, nShift, nXCoord, nYCoord)
*     .parent.parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
*     mouse at mrow(), mcol()
*!*			endif
	endwith
endproc

	procedure mousedown
	lparameters nButton, nShift, nXCoord, nYCoord
	with this

* initialize items that will be tested in MouseUp
		.mnColumnOrder = this.parent.columnorder
		.mnColumnWidth = this.parent.width
	endwith
endproc

	procedure mouseup
	lparameters nButton, nShift, nXCoord, nYCoord

	with this
* check to see if this was a resize or move
		.mlColumnMoved = ( this.parent.columnorder != .mnColumnOrder )
		.mlColumnSized = ( this.parent.width != .mnColumnWidth )
	endwith
endproc

	procedure dblclick
	this.click()
*this.parent.parent.SetOrder(this.parent.controlsource)
endproc

	procedure dWordStringToNumber
	parameter tcDWord
	local lnReturn, lnI

	if (vartype(m.tcDWord) <> "C") or (len(m.tcDWord) < 4)
		return 0
	endif

	lnReturn = 0
	for lnI = 1 to 4
		lnReturn = asc( substr(m.tcDWord, 5-m.lnI, 1)) + m.lnReturn
		if lnI <> 4
			lnReturn = m.lnReturn * 256
		endif
	endfor
	return m.lnReturn
endproc

	procedure MouseDownToolTip
	lparameters nButton, nShift, nXCoord, nYCoord
* !!!! NOTE:
* The code below is used to forward mouse clicks from this control to the
* control below it. The code it copied from
* the source of the Fancy ToolTip control by Paul-Vlad Tatavu
* from the www.levelextreme.com site, downloads section.
* Fancy ToolTip control provided for free, as described in the Readme.TXT
* file in the download file.
	local lnMouseX, lnMouseY
	local lcPointStructure
	local lnFormHandle, lnTopParentHandle, lnHandle
	local lnPressedKeys
	local lnButtonDown, lnButtonUp, lnMKButton
	local lnWM_MOUSEACTIVATE, lnWM_SETCURSOR, lnWM_MOUSEMOVE, ;
		lnWM_LBUTTONDOWN, lnWM_RBUTTONDOWN, lnWM_MBUTTONDOWN, ;
		lnWM_LBUTTONUP, lnWM_RBUTTONUP, lnWM_MBUTTONUP, ;
		lnHTCLIENT, lnMK_LBUTTON, lnMK_RBUTTON, ;
		lnMK_MBUTTON, lnMK_SHIFT, lnMK_CONTROL

*-- Declare Win32 API functions
	declare integer GetCursorPos ;
		in Win32API ;
		as __GetCursorPos__ ;
		string @lcPointStructure
	declare integer WindowFromPoint ;
		in Win32API ;
		as __WindowFromPoint__ ;
		integer lnX, ;
		integer lnY
	declare integer GetParent ;
		in Win32API ;
		as __GetParent__ ;
		integer lnWindowHandle
	declare integer SendMessage ;
		in Win32API ;
		as __SendMessage__ ;
		integer lnWindowHandle, ;
		integer lnMessage, ;
		integer lnWParam, ;
		integer lnLParam
	declare integer PostMessage ;
		in Win32API ;
		as __PostMessage__ ;
		integer lnWindowHandle, ;
		integer lnMessage, ;
		integer lnWParam, ;
		integer lnLParam
	declare integer ScreenToClient ;
		in Win32API ;
		as __ScreenToClient__ ;
		integer lnWindowHandle, ;
		string @lcPointStructure

*-- Get the cursor position relative to screen
	lcPointStructure = replicate(chr(0), 8)
	= __GetCursorPos__(@lcPointStructure)

*-- Extract the mouse coordinates from
*   the structure returned by GetCursorPosition()
	lnMouseX = this.dWordStringToNumber(;
		left(lcPointStructure, 4))
	lnMouseY = this.dWordStringToNumber(;
		right(lcPointStructure, 4))

*-- Get a handle to the window under mouse
*   (a handle to the current form, in this case)
	lnFormHandle = __WindowFromPoint__(lnMouseX, lnMouseY)

*-- Get a handle to the desktop window
*   that is a (grand)parent of the current form
	lnHandle = lnFormHandle
	do while lnHandle != 0
		lnHandle = __GetParent__(lnHandle)
		if lnHandle != 0
			lnTopParentHandle = lnHandle
		endif
	enddo

*-- Declare constants used by mouse messages
	lnWM_MOUSEACTIVATE = 0x0021
	lnWM_SETCURSOR     = 0x0020
	lnWM_MOUSEMOVE     = 0x0200

	lnWM_LBUTTONDOWN   = 0x0201
	lnWM_RBUTTONDOWN   = 0x0204
	lnWM_MBUTTONDOWN   = 0x0207
	lnWM_LBUTTONUP     = 0x0202
	lnWM_RBUTTONUP     = 0x0205
	lnWM_MBUTTONUP     = 0x0208

	lnHTCLIENT         = 0x0001

	lnMK_LBUTTON       = 0x0001
	lnMK_RBUTTON       = 0x0002
	lnMK_MBUTTON       = 0x0010
	lnMK_SHIFT         = 0x0004
	lnMK_CONTROL       = 0x0008

	lnPressedKeys = 0
	if bitand(nShift, 1) = 1
*-- The Shift key was pressed when
*   mouse was clicked
		lnPressedKeys = bitor(lnPressedKeys, lnMK_SHIFT)
	endif
	if bitand(nShift, 2) = 2
*-- The Ctrl key was pressed when
*   mouse was clicked
		lnPressedKeys = bitor(lnPressedKeys, lnMK_CONTROL)
	endif

	do case
	case nButton = 0 && Nothing was pressed
		lnButtonDown = 0
		lnButtonUp   = 0
		lnMKButton   = 0

	case nButton = 1
*-- Left button
		lnButtonDown = lnWM_LBUTTONDOWN
		lnButtonUp   = lnWM_LBUTTONUP
		lnMKButton   = lnMK_LBUTTON
	case nButton = 2
*-- Right button
		lnButtonDown = lnWM_RBUTTONDOWN
		lnButtonUp   = lnWM_RBUTTONUP
		lnMKButton   = lnMK_RBUTTON
	case nButton = 4
*-- Middle button
		lnButtonDown = lnWM_MBUTTONDOWN
		lnButtonUp   = lnWM_MBUTTONUP
		lnMKButton   = lnMK_MBUTTON
	endcase

*-- Convert mouse coordinates from screen coordinates
*   to form's client area coordinates
	= __ScreenToClient__(lnFormHandle, @lcPointStructure)
	lnMouseX = this.dWordStringToNumber(;
		left(lcPointStructure, 4))
	lnMouseY = this.dWordStringToNumber(;
		right(lcPointStructure, 4))

*-- Simulate a mouse up message(s)
*   (Will be received by the behind control)
	lnLParam = lnMouseY * 256 * 256 + lnMouseX
	= __SendMessage__( ;
		lnFormHandle, ;
		lnButtonUp, ;
		lnMKButton + lnPressedKeys, ;
		lnLParam)
	lnLParam = lnWM_MOUSEMOVE * 256 * 256 + lnHTCLIENT
	= __SendMessage__( ;
		lnFormHandle, ;
		lnWM_SETCURSOR, ;
		lnFormHandle, ;
		lnLParam)
	lnLParam = lnMouseY * 256 * 256 + lnMouseX
	= __PostMessage__( ;
		lnFormHandle, ;
		lnWM_MOUSEMOVE, ;
		lnPressedKeys, ;
		lnLParam)

*-- Hide the control
*	this.visible = .f.
*-- Simulate a mouse down message(s)
*   (Will be received by the control under mouse)
	lnLParam = lnButtonDown * 256 * 256 + lnHTCLIENT
	= __SendMessage__( ;
		lnFormHandle, ;
		lnWM_MOUSEACTIVATE, ;
		lnTopParentHandle, ;
		lnLParam)
	= __SendMessage__( ;
		lnFormHandle, ;
		lnWM_SETCURSOR, ;
		lnFormHandle, ;
		lnLParam)
	lnLParam = lnMouseY * 256 * 256 + lnMouseX
	= __PostMessage__( ;
		lnFormHandle, ;
		lnButtonDown, ;
		lnMKButton, ;
		lnLParam)

*	this.visible = .t.
endproc
enddefine
If it's not broken, fix it until it is.


My Blog
Previous
Reply
Map
View

Click here to load this message in the networking platform