Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Control bound to foreign key
Message
From
19/06/2006 16:19:06
 
 
To
15/06/2006 10:37:29
General information
Forum:
Visual FoxPro
Category:
Object Oriented Programming
Miscellaneous
Thread ID:
01129284
Message ID:
01130077
Views:
19
Hi guys,

I thought I'd share what I came up with. Some of this is definitely special-purpose junk from my internal classes.

Internally, we have a textbox class that allows searching and navigation of an indexed field using some keystrokes. It is based on my base textbox class, so I'll include the 3 in the hieratchy here. It is not elegant, but seems to do what I want.

In order by hierarchy:

The base class -
**************************************************
*-- Class:        icgcommontext (c:\development\test\test.vcx)
*-- ParentClass:  textbox
*-- BaseClass:    textbox
*-- Time Stamp:   06/15/06 11:23:02 AM
*
DEFINE CLASS icgcommontext AS textbox


	Anchor = 768
	Height = 23
	Width = 100
	builderx = "c:\development\builders\libs\icgbuilders, icgtxtbuilder"
	Name = "icgcommontext"
	autocr = .F.

	*-- logical for setting to all caps
	upcase = .F.


	PROCEDURE setexprops
		* shell method for setting properties with an expression on init.
		If (This.UpCase)		&& will set to upper case input
			If (This.MaxLength > 0)
				This.Format = Replicate("!",This.MaxLength)
			Endif
		Endif
	ENDPROC


	PROCEDURE onchange
		*** shell method to fire when control value changes
	ENDPROC


	PROCEDURE Init
		this.SetExProps()	&& set expression-based properties 
		DODEFAULT()
	ENDPROC


	PROCEDURE GotFocus
		DoDefault()
		If (This.autocr)
			Set Confirm Off
		Else
			Set Confirm On
		Endif
	ENDPROC


	PROCEDURE value_assign
		LPARAMETERS vNewVal
		*To do: Modify this routine for the Assign method
		THIS.VALUE = m.vNewVal
	ENDPROC


	*-- documentation
	PROCEDURE zreadme
	ENDPROC


ENDDEFINE
*
*-- EndDefine: icgcommontext
**************************************************
The normal searchable textbox -
**************************************************
*-- Class:        icgcommonsrchfield (c:\development\test\test.vcx)
*-- ParentClass:  icgcommontext (c:\development\icgcommon\libs\icgcommon.vcx)
*-- BaseClass:    textbox
*-- Time Stamp:   06/15/06 02:59:08 PM
*-- searchable field
*
DEFINE CLASS icgcommonsrchfield AS icgcommontext


	FontSize = 9
	Anchor = 768
	Height = 23
	StatusBarText = "F5 - BEG        F6 - END        F7 - PREV        F8 - NEXT        F9 - FIND        F11 - SAVE"
	Width = 100
	*-- Boolean to tell whether a field is searchable or not
	searchable = .T.
	icsrchalias = ""
	icsrchtag = ""
	builderx = "c:\development\builders\libs\icgbuilders, srchtxtbuilder"
	upcase = .T.
	Name = "icgcommonsrchfield"
	ltracknavigation = .F.


	*-- does a search of the current field if there is a key for it.
	PROCEDURE search
		*** Search Method
		gcseekval = This.Value
		If Type("gcseekval") = 'C'
			gcseekval = Alltrim(gcseekval)
		Endif
		=Tablerevert(.T.)
		Thisform.Revert

		Set Near On
		If !Empty(This.icsrchalias)
			If !Empty(This.icsrchtag)
				=Seek(gcseekval, This.icsrchalias, This.icsrchtag)
				Set Order To Tag ( This.icsrchtag )
			Endif
		Endif

		If Eof()
			Go Bottom
		Endif
		If (This.ltracknavigation)
			This.UpdateOnNav()
		Endif

		Thisform.Refresh()
	ENDPROC


	*-- Go to Last Record in current order
	PROCEDURE goend
		*** GoEnd
		=tablerevert(.T.)
		Thisform.Revert
		GO BOTTOM
		If (This.ltracknavigation)
			This.UpdateOnNav()
		Endif

		THISFORM.Refresh()
	ENDPROC


	*-- Go to Top Record in current order
	PROCEDURE gotop
		*** GoTop
		=tablerevert(.T.)
		Thisform.Revert

		GO top
		If (This.ltracknavigation)
			This.UpdateOnNav()
		Endif

		THISFORM.Refresh()
	ENDPROC


	*-- Go to next record in current order
	PROCEDURE gonext
		*** GoNext 
		=tablerevert(.T.)
		Thisform.Revert
		IF !EOF()
			SKIP 1
		ENDIF
		IF EOF()
		  GO BOTTOM
		ENDIF
		If (This.ltracknavigation)
			This.UpdateOnNav()
		Endif

		THISFORM.Refresh()
	ENDPROC


	*-- Go To Prev record in current order.
	PROCEDURE goprev
		*** GoPrev
		=Tablerevert(.T.)
		Thisform.Revert

		If !Bof()
			Skip -1
		Endif

		If Bof()
			Go Top
		Endif
		If (This.ltracknavigation)
			This.UpdateOnNav()
		Endif

		Thisform.Refresh()
	ENDPROC


	PROCEDURE embeddedsearch
		*** Embedded Search Method
		gcseekval = This.Value
		If Type("gcseekval") = 'C'
			gcseekval = Alltrim(gcseekval)
		Endif
		cCtrl = This.ControlSource
		=Tablerevert(.T.)
		Browse For (gcseekval $ &cCtrl)
		If (This.ltracknavigation)
			This.UpdateOnNav()
		Endif

		Thisform.Refresh()
	ENDPROC


	PROCEDURE setexprops
		DODEFAULT()
		this.icsrchalias = ALLTRIM(this.icsrchalias)
		this.icsrchtag = ALLTRIM(this.icsrchtag)
	ENDPROC


	PROCEDURE When
		This.ForeColor = Rgb(0,0,255)  && Blue
	ENDPROC


	PROCEDURE RightClick
		this.browse
		thisform.Refresh()
	ENDPROC


	PROCEDURE KeyPress
		Lparameters nKeyCode, nShiftAltCtrl
		Local lnSellngth
		If This.searchable
			Do Case
			Case nKeyCode = -8 && F9 - SRCH
				This.Search
				Nodefault
			Case nKeyCode = -7 && F8 - NEXT
				This.GoNext
				Nodefault
			Case nKeyCode = -6 && F7 - PREV
				This.GoPrev
				Nodefault
			Case nKeyCode = -5 && F6 - END
				This.GoEnd
				Nodefault
			Case nKeyCode = -4 && F5 - TOP
				This.GoTop
				Nodefault
			Case nKeyCode = -2 && F3 - Embedded srch
				This.EmbeddedSearch
				Nodefault
			Endcase
		Endif
	ENDPROC


	PROCEDURE GotFocus
		DoDefault()
		If !Empty(This.icsrchalias)
			Select ( This.icsrchalias )
			If !Empty(This.icsrchtag)
		*		Set Order To Tag ( This.icsrchtag )
			Endif
		Endif
	ENDPROC


	PROCEDURE LostFocus
		DoDefault()
		This.ForeColor = Rgb(0,0,0)  &&
	ENDPROC


	*-- browse this field
	PROCEDURE browse
	ENDPROC


ENDDEFINE
*
*-- EndDefine: icgcommonsrchfield
**************************************************
And the new subclass of that, using underlying FK's
**************************************************
*-- Class:        icgcommonsrchfk (c:\development\test\test.vcx)
*-- ParentClass:  icgcommonsrchfield (c:\development\test\test.vcx)
*-- BaseClass:    textbox
*-- Time Stamp:   06/19/06 02:59:02 PM
*
DEFINE CLASS icgcommonsrchfk AS icgcommonsrchfield


	*-- underlying FK field to be updated
	icunderlyingfk = ""
	*-- table to perform lookups in
	iclookuptable = ""
	*-- index tag in lookup table to search
	iclookuptag = ""
	*-- temp alias for the lookup table opened again in a separate work area to keep from messing up relations
	iclookupalias = ""
	*-- underlying table containing the FK to be updated
	icunderlyingalias = ""
	*-- field from the lookup table to update the FK with
	icupdatesource = ""
	lfound = .F.
	*-- validation msg
	cvalidmsg = ""
	Name = "icgcommonsrchfk"


	PROCEDURE dolookup
		&& lookup
		Lparameters vSeekVal, llExact
		Local cLookupAlias, cUpdateAlias, cUpdateField, cUpdateFrom

		If Empty(This.iclookupalias)
			This.opentemp()
		Endif
		cLookupAlias = This.iclookupalias
		cUpdateAlias = This.icunderlyingalias
		cUpdateField = This.icunderlyingfk
		cUpdateFrom = Alltrim(cLookupAlias)+[.]+Alltrim(This.icupdatesource)
		*SELECT ( cLookupAlias )
		If !llExact
			Set Near On
		ENDIF

		this.lfound = .F.

		If Seek(vSeekVal,cLookupAlias,This.iclookuptag)
		this.lfound = .T.
		*	Select ( cUpdateAlias )
			Return &cUpdateFrom
		Endif
	ENDPROC


	PROCEDURE opentemp
		&&
		Local cFileName1
		If !Empty(This.iclookuptable)
			cFileName1 = Substr(Sys(2015), 3, 10)  && create temp file
			This.iclookupalias = cFileName1
			Use ( This.iclookuptable ) In 0 Again Alias &cFileName1
		Endif
	ENDPROC


	PROCEDURE doupdate
		&& update the fk here

		Lparameters vUpDateVal
		Local cUpdateAlias, cUpdateField


		cUpdateAlias = This.icunderlyingalias
		cUpdateField = This.icunderlyingfk
		Select ( cUpdateAlias )
		Replace &cUpdateField With vUpDateVal
	ENDPROC


	PROCEDURE search
		*** Search Method
		&& to-do:
		*!*	1. Fix seekval to be the underlying FK not the controlsourced value
		*!*		1. perform lookup and substitute that.
		*!*		2. revert the lookup table (controlsource alias)
		*!*		3. do seek, and set index
		Local cLookupAlias
		gcseekval = This.dolookup(This.Value, .F.)
		If Type("gcseekval") = 'C'
			gcseekval = Alltrim(gcseekval)
		Endif
		cLookupAlias = This.iclookuptable
		=Tablerevert(.F.,cLookupAlias)
		Thisform.Revert

		Set Near On
		If !Empty(This.icsrchalias)
			If !Empty(This.icsrchtag)
				=Seek(gcseekval, This.icsrchalias, This.icsrchtag)
				Set Order To Tag ( This.icsrchtag )
			Endif
		Endif

		If Eof()
			Go Bottom
		Endif
		If (This.ltracknavigation)
			This.UpdateOnNav()
		Endif

		Thisform.Refresh()
	ENDPROC


	PROCEDURE Valid
		&&
		Local lgUpdateval

		lgUpdateval = This.dolookup(This.Value,.T.)

		If !(This.lfound)
			WAIT WINDOW this.cvalidmsg NOWAIT 
			Return 0
		ELSE
			this.Doupdate(lgUpDateVal)
			Return .T.
		Endif
	ENDPROC


ENDDEFINE
*
*-- EndDefine: icgcommonsrchfk
**************************************************
Jim Newsom
IT Director, ICG Inc.
Previous
Reply
Map
View

Click here to load this message in the networking platform