Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Grid ordering
Message
 
 
To
06/12/2004 11:32:05
General information
Forum:
Visual FoxPro
Category:
Other
Title:
Environment versions
Visual FoxPro:
VFP 8 SP1
OS:
Windows 2000 SP4
Network:
Windows 2003 Server
Database:
Visual FoxPro
Miscellaneous
Thread ID:
00967218
Message ID:
00967260
Views:
7
>Is that my only option?

I think your other option would be to build a temporary non-structural index based on that expression (or UDF). You would need to delete this index when you close the form. You can borrow some code ideas from the following code by Vlad Grynchyshyn:
procedure CreateTag
* assuming alias for sorting is in current workarea
* assuming this method is called from the Sorting Manager code only from this class.

	with this
* calculate the expression for sorting
		local lc__SortExpr, lnLimitation
		lnLimitation = iif(set("Collate")=="MACHINE",240,120)
		if empty(.SortingExpression)
			lc__SortExpr = .parent.controlsource
* make basic checking for control source type
			local lcType, lnValLen, llIsField
			lcType = type(m.lc__SortExpr)
			llIsField = '.' $ m.lc__SortExpr and ;
				used(left(m.lc__SortExpr,at('.',m.lc__SortExpr)-1)) and ;
				fsize(substr(m.lc__SortExpr,at('.',m.lc__SortExpr)+1),left(m.lc__SortExpr,at('.',m.lc__SortExpr)-1)) > 0
				
			do case
			case m.lcType $ "GOPUS"
				lc__SortExpr = ""
				
			case m.lcType == "C"
				if m.llIsField
					lnValLen = min(fsize(substr(m.lc__SortExpr,at('.',m.lc__SortExpr)+1),left(m.lc__SortExpr,at('.',m.lc__SortExpr)-1)),m.lnLimitation)
				else
					lnValLen = m.lnLimitation
				endif
				lc__SortExpr = "PADR(NVL(" + m.lc__SortExpr + ",'')," + allt(str(m.lnValLen))+")"
				
			case m.lcType == "M"
				lc__SortExpr = "PADR(" + m.lc__SortExpr + "," + allt(str(m.lnLimitation))+")"
				
			otherwise
				do case
				case m.lcType $ "DT"
					lc__SortExpr = "NVL(" + m.lc__SortExpr + ",{})"
				case m.lcType == "L"
					lc__SortExpr = "NVL(" + m.lc__SortExpr + ",.F.)"
				case m.lcType == "Y"
					lc__SortExpr = "NVL(" + m.lc__SortExpr + ",$0)"
				otherwise
					lc__SortExpr = "NVL(" + m.lc__SortExpr + ",0)"
				endcase
			endcase
		else
			lc__SortExpr = .SortingExpression
		endif

&& create index tag
		if !empty(m.lc__SortExpr)
			.CurrentTag = "T" + substr(alltrim(sys(2015)), 4, 10) && generate unique tag name

			local lnRestoreBuffering
			lnRestoreBuffering = cursorgetprop('Buffering')
			if m.lnRestoreBuffering >= 4
&& OOPS - cannot index cursors in 5 buffering mode.
&& check that it does not contain modified records
				if getnextmodified(0) = 0
					cursorsetprop('Buffering',iif(m.lnRestoreBuffering=5,3,2))
				else
&& OOPS - we will not be able to index it...
					.CurrentTag = ""
				endif
			endif

&& check how we should create index - structural or non-structural
			.lNonStructural = cursorgetprop('SourceType')=3 and (! isexclusive() or ;
				!(cursorgetprop('Database')=="") or !(sys(2023) == justpath(dbf())) )
* it is a table for which either database is specified or file path is not in temporary folder
* or just alias is not opened in exclusive mode (file in temporary folder, but it is shared)

			if !empty(.CurrentTag)
&& disable errors
				local lc___OldError
				private m.ll__Error
				ll__Error = .f.
				lc___OldError = on("ERROR")
				on error m.ll__Error = .t.

				local llShowHere, lnOldRecNo
				lnOldRecNo = iif(eof(),0,recno())
				llShowHere = .f.
				if reccount() > 1000
					llShowHere = .t.
					.DispSortingMessage(.t.)
				endif

				if .lNonStructural
					index on ;
						&lc__SortExpr ;
						tag (.CurrentTag) of (sys(2023) + "\" + .CurrentTag) additive
				else
					index on ;
						&lc__SortExpr ;
						tag (.CurrentTag) additive
				endif

				if m.llShowHere
					.DispSortingMessage(.f.)
				endif

				if m.ll__Error && error occurred during indexing
					.CurrentTag = "" && indicate no tag is created
				endif

* restore record number
				if m.lnOldRecNo = 0
					go bottom
					if !eof()
						skip
					endif
				else
					go (m.lnOldRecNo)
				endif

				on error &lc___OldError

				if m.lnRestoreBuffering >= 4
					cursorsetprop('Buffering',m.lnRestoreBuffering)
				endif
			endif
		else
			.CurrentTag=""
		endif
	endwith
endproc
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