Wiki Home

Carls Vcx Utils


Namespace: WIN_COM_API
Here are some utilites I have written to chew on Vcx's.

* Program Vcxs2prg.prg
* Compares two directories full of class libraries.
* Well, creates prgs that can be compared using your favorite compare utility.
* Unix Diff (-I ignore regExp)( "\*" = comments )  - diff -I "\*" old/ new/
* diff options:
*  -b     Ignore changes in amount of white space.
*  -B     Ignore  changes  that  just  insert or delete blank lines.
*  -i     Ignore  changes in case; consider upper- and lower-case letters equivalent.
* -I "return" -I "#INCLUDE" -I "SET CLASSLIB"  (ignore cuz different paths)
* -F regexp   In  context  and  unified  format, for each hunk of differences, show some of the last  preceding  line that matches regexp.

* and e32.exe from www.semware.com
* By CarlKarsten

* Converts a dir full of vcx's to code 

do (_browser)

* This will build the files for both libs and ilibs, both yours and new.

* Old libs
lOneDir( "d:\vfe60\vfeframe\libs\", "d:\temp\vfecmp\60\libs\" )

* Old iLibs
lOneDir( "d:\vfe60\ilibs\", "d:\temp\vfecmp\60\ilibs\" )

* New libs
lOneDir( "d:\vfe6\vfeframe\libs\", "d:\temp\vfecmp\63\libs\" )

* New iLibs
lOneDir( "d:\vfe6\ilibs\", "d:\temp\vfecmp\63\ilibs\" )

_obrowser.release()

* Now you have a bunch of prgs to compair.

return
**********************************************************************
function lOneDir( tcVcxDir, tcCodDir )
* Process all VCX's in tcVCXdir,
* create code in CodDir

local ;
	lcVcxDir, lcCodDir, ;
	laVcxs(1), lnVcxs, lcVcx, ;
	lnI

lcVcxDir = addbs( tcVcxDir )

if pCount() = 1
	lcCodDir = lcVcxDir
else
	lcCodDir = addbs( tcCodDir )
endif

lnVcxs = aDir( laVcxs, lcVcxDir + "*.vcx" )
for lnI = 1 to lnVcxs
	lcVcx = laVcxs( lnI, 1 )
	lcCod = forceext( lcVcx, "prg" )
	lOneVcx( lcVcxDir + lcVcx, lcCodDir + lcCod )
endfor

return
**********************************************************************
function lOneVcx( tcVcx, tcCod )
* Process One VCX, create code as tcCod file

local ;
	lcTmpVcx
	
* clean up the vcx so that you are comparing apples and apples.
DO lOneVcx WITH tcVcx IN vcxcmt

_oBrowser.OpenFile( tcVcx )
_oBrowser.ExportClass( .f., tcCod )

return
**********************************************************************
* eof: VcxCmp.prg

* Program VcxCmt.prg
* Adds {headers, returns, footers}
* to all the methods of all the classes in a dir.
* By CarlKarsten

#Define CRLF Chr(13)+Chr(10)

lOneDir( "d:\vfe7\vfeframe\libs\" )
* lOneDir( "d:\dev\apps\dis\libs\", "*.vcx" )

* lOneDir( "D:\dev\util\pjx\trakproj\", "*.vcx" )
* lOneDir( "D:\dev\josh\skedstar", "*.scx" )

* lOneDir( "d:\vfe6\tools\builderb\" )
* lOneDir( "d:\vfe7\sample\libs\", "*.vcx")
* lOneDir( "d:\vfe7\ilibs\", "ip*vcx")
* lOneDir( "d:\vfe6\classes\" )
* lOneDir( "d:\vfe6\ilibs\", "*.vcx" )
* lOneDir( "d:\stonefield\sfreports", "SfReports.vcx" )
* lOneDir( "d:\stonefield\sfcommon\", "*.vcx" )
* lOneDir( "d:\stonefield\sfquery\", "*.vcx" )
* lOneDir( ".\", "STUD_ED.scx" )
* lOneDir( "d:\dev\tests\carcolors\ilibs\", "*.vcx" )
* lOneDir( ".\", "*.vcx" )
* lOneDir( "d:\vfe7\tools\pjxhookx\", "*.vcx" )


Return
**********************************************************************
Function lOneDir( tcVcxDir, tcVcxMask )
	* Process all VCX's in tcVCXdir,

	Local ;
		lcVcxDir, ;
		lcVcxMask, ;
		laVcxs(1), lnVcxs, lcVcx, ;
		lnI

	lcVcxDir = Addbs( tcVcxDir )
	lcVcxMask = Iif( Empty( tcVcxMask), "*.vcx", tcVcxMask )

	lnVcxs = Adir( laVcxs, lcVcxDir + lcVcxMask )

	If lnVcxs = 0
		? "No vcx's found in " + lcVcxDir
	Endif

	For lnI = 1 To lnVcxs
		lcVcx = laVcxs( lnI, 1 )
		lOneVcx( lcVcxDir + lcVcx )
	Endfor

	Return
	**********************************************************************
Function lOneVcx( tcVcx )
	* Process One VCX
	* comments the method field of the vcx

	? tcVcx

	Use (tcVcx) Exclusive

	* Browse FIELDS METHODS FOR !Empty( METHODS )

	Try
		* add objectname and vcx to header, add return to end if needed.
		Replace All Methods With ;
			lCmtMth( Methods, Parent, objName, tcVcx ) For !Empty( Methods )

		*	lCmtMth( methods, objName, tcVcx ) for !empty( methods )

		* Sort Methods
		Replace All Methods With ;
			lSrtMth( Methods ) For !Empty( Methods )

		* This stopped working about the time vfp8 came out, but stopped in 7 too - i don't get it.
		* Sort reserved3 so that PdDn-ing thourgh methods are also sorted
		* replace reserved3 with laSrtMem( reserved3 ) ;
for !empty( reserved3 )

		* "Fixes" some pointers that align methods in the class browser to the code.
		* This you need if you mess with the method field.
		USE 
		
		Compile Classlib (tcVcx)

	Catch To loError When loError.Message = "Variable 'METHODS' is not found."
		USE 
		
	Endtry

	Return
	**********************************************************************
Function lCmtMth( tcMth, tcParent, tcCls, tcVcx )
	* function lCmtMth( tcMth, tcCls, tcVcx )

	* Adds a comment to the top of each method: object::method {vcx}
	* and a return at the end
	* and a comment at the end too
	* Parameters:
	* tcMth: Methods from Method field of a vcx.
	* tcCls: Class cotaining these methods -- from class field (trim(class))
	* tcVcx: name of VCX file this class is in

	* MODIFY CLASS ATTENDEESFORM OF "d:\dev\apps\cc\libs\aforms.vcx" method pgfAttendees.pagList.grdAttendees.enabled_assign
	*        Class attendeesform of d:\dev\apps\cc\libs\AFORMS.VCX Method grdAttendees.enabled_assign
	Local ;
		laLins(1), lnLins, lcLin, ;
		lcMthCod, ;
		llRetOk, ;
		lcFull, lcClass, lcObj, lcMethod, lcCurMethod

	lcFull = Iif( Empty( tcParent ), "", tcParent + "." ) + tcCls
	lcClass = Substr( lcFull, 1, At(".", lcFull+".")-1 )
	lcObj = Iif( "."$lcFull, Substr( lcFull, At(".", lcFull)+1 ), "" )

	* If we never find any code (including comments), no need for a return statement
	llRetOk = .T.
	lcMthCod = ""
	lnLins = Alines( laLins, tcMth )
	For Each lcLin In laLins

		Do Case

			Case lcLin = "PROCEDURE"

				lcMethod = Iif( !Empty(lcObj), lcObj + ".", "" ) + Substr( lcLin, Len( "PROCEDURE" )+2 )

				Do Case
					Case Lower( Justext( tcVcx )) = "vcx"
						lcCurMethod = "** Modify Class "
					Case Lower( Justext( tcVcx )) = "scx"
						lcCurMethod = "** Modify Form "
				Endcase

				lcCurMethod = lcCurMethod ;
					+ lcClass + " of [" + tcVcx + "]" ;
					+ " Method " + lcMethod

				lcLin = lcLin + CRLF + lcCurMethod

			Case lcLin = "** Method: " And "::" $ lcLin And "{" $ lcLin And Lower( Right( lcLin, 5 ) ) = ".vcx}"
				* Eat this way OLD header line, a new header has been added.
				Loop

			Case lcLin = "** Class " And " of [" $ lcLin And " Method " $ lcLin
				* Eat this OLD header line, a new header has been added.
				Loop

			Case lcLin = "** Modify " And " of [" $ lcLin And " Method " $ lcLin
				* Eat this header line, a new header has been added.
				Loop

			Case lcLin = "ENDPROC"

				* We can rebuild it - it will be better than it was before.
				lcLin = ""

				* If the last non blank line was not "return", add a return.
				If !llRetOk
					*				lcLin = lcLin + "** next line (Return) added by " + PROGRAM(0) + CRLF
					lcLin = lcLin + "Return .t." + CRLF
				Endif
				lcLin = lcLin + lcCurMethod + CRLF + CRLF
				lcLin = lcLin + "ENDPROC" + CRLF

			Case Lower( Alltrim( Chrtran(lcLin, Chr(9), "" ) ) ) = "return"
				* found a return, so don't add one unless we find more code
				llRetOk = .T.

			Case !Empty( lcLin )

				* found code, so we need a return

				* I used to skip methods that only had a comment in them. That was wrong.
				* Even a comment in a method will cause
				* that method to get executed, not the code in the parent class.
				* You don't really see this in the debugger, because with no real code,
				* there is nothing for the debugger to step to, so it just exits the method.
				* So putting a return in the 'empty' method is a good idea so you can see
				* in the bugger which method executed

				llRetOk = .F.

		Endcase

		lcMthCod = lcMthCod + lcLin + CRLF

	Endfor

	Return lcMthCod
	**********************************************************************
Function lSrtMth( tcMth )

	* Sorts procedures file by procedure name

	Local ;
		lnSel, ;
		laLins(1), lnLins, lcLin, ;
		lcMthNam, ;
		lcMthCod, ;
		lcRet

	lnSel = Select()

	Create Cursor Mths ( cMthNam c(60), cMthCod m )
	lnLins = Alines( laLins, tcMth )
	lcMthCod = ""
	For Each lcLin In laLins

		lcMthCod = lcMthCod + lcLin + Chr(13) + Chr(10)
		Do Case
			Case lcLin = "PROCEDURE"
				lcMthNam = Substr( lcLin, Len( "PROCEDURE " ) )
			Case lcLin = "ENDPROC"
				Insert Into Mths Values ( lcMthNam, lcMthCod )
				lcMthCod = ""
		Endcase

	Endfor

	* Sort by proc name
	Index On cMthNam Tag cMthNam

	* Make a big string out of all the procs
	lcRet = ""
	Scan
		lcRet = lcRet + cMthCod
	Endscan
	Use

	Select (lnSel)

	Return lcRet
	**********************************************************************
Function laSrtMem( tcMem )
	* Sort Memo

	Local ;
		lnMlns, laMLns(1), lcMln, ;
		lcRet

	* Put in array
	Alines( laMLns, tcMem )

	* Sort
	Asort( laMLns )

	* Put back into big string
	lcRet = ""
	For Each lcMln In laMLns
		lcRet = lcRet + lcMln + Chr(13) + Chr(10)
	Endfor

	Return lcRet
	**********************************************************************
	* eof: VcxCmt.prg


SubSettings finds the changes that a subclass has made on its parent class.

I think this is based on the "straight to hell" pattern, because that is where I am going to be sent when the OOP gods take a look at this.

* SubSetings.prg
#DEFINE CRLF CHR(13)+CHR(10)

clear

_cliptext = ""

ox = CREATEOBJECT( "ObjIter" )
ox.cMask = "ibizness.VCX"
ox.OneDir()
ox.cMask = "idata.VCX"
ox.OneDir()
RELEASE ox

RETURN

DEFINE CLASS DirIter as Custom
	
	* process files in a dir
	
	cPath = "d:\vfe6\ilibs\"
	cMask = "*.vcx"
	lRecurse = .f. && currently no support for .t.
	lExit = .f.
		
	cFileName = ""
	
	PROCEDURE OneDir
	
		LOCAL ;
			lnFiles, lnFile, laFiles(1)
			
		WITH this
			lnFiles = ADIR( laFiles, ADDBS( .cPath ) + .cMask )
			FOR lnFile = 1 TO lnFiles
				.cFileName = laFiles( lnFile, 1 )
				.OneFile()
				IF .lExit
					EXIT
				ENDIF 			
			ENDFOR
		ENDWITH
	ENDPROC 

	PROCEDURE OneFile
		? this.cFileName
	ENDPROC 
	
ENDDEFINE

			
DEFINE CLASS VcxIter as DirIter

	* Processes all classes in a vcx

	cClassName = ""

	PROCEDURE OneFile
			
		LOCAL ;
			lnClasses, lnClass, laClasses(1)
			
		WITH this
			lnClasses = AVCXCLASSES( laClasses, ADDBS( .cPath ) + .cFileName )
			FOR lnClass = 1 TO lnClasses
				.cClassName = laClasses( lnClass, 1 )
				.OneClass()
				IF .lExit
					EXIT
				ENDIF 			
			ENDFOR

		ENDWITH
				
	ENDPROC
	
	PROCEDURE OneClass
		? this.cFileName, this.cClassName
	endproc				
	
ENDDEFINE


DEFINE CLASS ClassIter as VcxIter

	PROCEDURE OneClass
	
		local ;
			lnObjs, lnObj, laObjs(1)

		WITH this
				
			modi class ( .cClassName ) of ( ADDBS( .cPath ) + .cFileName ) nowait
			lnObjs = aSelObj( laObjs, 1 )

			FOR lnObj = 1 TO lnObjs
				_cliptext = _cliptext +  .OneObject( laObjs( lnObj ), 0 )
				IF .lExit
					EXIT
				ENDIF 			
			ENDFOR

			SYS(1500, '_MFI_CLOSE', '_MSM_FILE')

		ENDWITH 
	
	ENDPROC
	
	PROCEDURE OneObject( toObject, tnLevel )
		? toObject.Name
	endproc

ENDDEFINE 


DEFINE CLASS ObjIter as ClassIter 

	lShowMethodCode = .f.
	
	PROCEDURE OneObject( toObject, tnLevel )
	
		* returns a string of Non-Default PEMs and values

		local ;
			laPems(1), lnPems, lnPem, lcPem, lcPemTyp, ;
			luPrpVal, ;
			luPntPrpVal, ;
			lcPrpVal, ;
			lcObjDsc, ;
			lcPemList,;			
			loTempObj

		WITH this
			
			lcPemList = ""
				
			IF toObject.BaseClass <> "Olecontrol"

				* Get a list of the members of the passed object
				lnPems = aMembers( laPems, toObject, 1 )
				for lnPem = 1 to lnPems

					* The current PEM and type
					lcPem = laPems( lnPem, 1 )
					lcPemTyp = laPems( lnPem, 2 )
	 
					do case
						
						case lcPemTyp = "Property"
							* If the property is an array... (finish when needed)
							DO case
								CASE type( "ALEN(toObject." + lcPem + ")" ) = "N"
					*				lcPemList = lcPemList + space( tnLevel*2 ) + lcPem + "()..." + CRLF
								CASE INLIST( lcPem, "NAME", "HEIGHT", "LEFT", "TOP", "WIDTH" )
									* Name and all dosn't count, so skip this one.
							 	otherwise
									* If the Property's value overrides the ParentClass, add it to the list.
									if PEMStatus( toObject, lcPem, 0 )
										luPrpVal = getPEM( toObject, lcPem )
										lcPrpVal = transform( luPrpVal )
										lcPemList = lcPemList + space( tnLevel*2 ) + lcPem ;
											+ " = " + lcPrpVal + CRLF
									endif
							endcase
							
						case inlist( lcPemTyp, "Event",  "Method" )
							* If there is code in the method, 							
							if !empty( GetPEM( toObject, lcPem ) )
								lcPemList = lcPemList + ;
									space( tnLevel*2 ) + lcPemTyp + " " + lcPem + CRLF
								IF .lShowMethodCode 
									* show the code
									lcPemList = lcPemList + ;
										GetPEM( toObject, lcPem ) + CRLF
								endif
							endif

						case lcPemTyp = "Object"
							* Recursively call OneObject, bump the indent level
							lcObjDsc = .OneObject( eval( "toObject." + lcPem ), tnLevel + 1 )
							* If there are some overrides, add to the list
							if !empty( lcObjDsc )
								lcPemList = lcPemList + space( tnLevel*2 ) + lcPem + CRLF ;
								+ lcObjDsc
							endif

					endcase
					
				endfor
			
			ENDIF
						
		ENDWITH 
		
		RETURN lcPemList
		
	ENDPROC
	
	PROCEDURE cCatList
	
ENDDEFINE 

diff lines:
diff -b -B -i -I "return" -I "#INCLUDE" -I "SET CLASSLIB" -I "\*" old/ new/


Variants of Vcxs2prg.prg and Vcx Cmt.prg by Vlad Tokarev
Some code sections marked with "VT".

* Program Vcxs2prg.prg
* Compares two directories full of class libraries.
* Well, creates prgs that can be compared using your favorite compare utility.
* Unix Diff (-I ignore regExp)( "\*" = comments ) - diff -I "\*" old/ new/
* diff options:
* -b Ignore changes in amount of white space.
* -B Ignore changes that just insert or delete blank lines.
* -i Ignore changes in case; consider upper- and lower-case letters equivalent.
* -I "return" -I "#INCLUDE" -I "SET CLASSLIB" (ignore cuz different paths)
* -F regexp In context and unified format, for each hunk of differences, show some of the last preceding line that matches regexp.

* and e32.exe from www.semware.com
* By CarlKarsten

#Define CRLF Chr(13)+Chr(10)

set safety off
set alternate to (program() + '.log')
set alternate on
set safety on

* Converts a dir full of vcx's to code
* 
* Browser.PRG
* PARAMETERS tcFileName, tcDefaultClass, tlListBox, tcClassType,;
*            tnWindowState, tlGallery, tlNoShow
* 
* DO (_BROWSER) [WITH [tcFileName][, tcDefaultClass[.member]]
*                     [,tlListBox][, tcClassType][, tnWindowState]]
* tcFileName  - The name of the .vcx, .scx, .olb, .tlb, .pjx, or .exe file
*               to open in the Class Browser.
* tcDefaultClass[.member] - The class in the .vcx to be selected by default.
*                           If no default class is specified, the class
*                           library is selected. If a member is specified,
*                           that member is selected in the Members list.
* tlListBox - Specifies whether to display the classes and members in
*             list boxes rather than treeview controls.
*             Include true (.T.) for this parameter to display the list
*             boxes. The default is false (.F.)
* tcClassType - Specifies the initial Type filter for the classes displayed
*               in the Class Browser. You can change the filter in the
*               Class Browser by choosing another value from the Type list.
*               The default is no filter.
* tnWindowState   0 - Normal (the default)
*                 1 - Minimized
*                 2 - Maximized
* tlGallery - Default .F.
*             Specifies whether to open in the Component Gallery instead
*             of the Class Browser.
*             Use true (.T.) to open in the Component Gallery.
* tlNoShow -

* do (_browser)
do (_browser) with ,,,,,,.t.


* This will build the files for both libs and ilibs, both yours and new.

lOneDir( fullpath('') )
if .f.
* Old libs
lOneDir( "d:\vfe60\vfeframe\libs\", "d:\temp\vfecmp\60\libs\" )

* Old iLibs
lOneDir( "d:\vfe60\ilibs\", "d:\temp\vfecmp\60\ilibs\" )

* New libs
lOneDir( "d:\vfe6\vfeframe\libs\", "d:\temp\vfecmp\63\libs\" )

* New iLibs
lOneDir( "d:\vfe6\ilibs\", "d:\temp\vfecmp\63\ilibs\" )
endif

_obrowser.release()

* Now you have a bunch of prgs to compair.

set alternate off
set alternate to
return
**********************************************************************
function lOneDir( tcVcxDir, tcCodDir )
* Process all VCX's in tcVCXdir,
* create code in CodDir

local ;
	lcVcxDir, lcCodDir, ;
	laVcxs(1), lnVcxs, lcVcx, ;
	lnI

lcVcxDir = addbs( tcVcxDir )

if pCount() = 1
	lcCodDir = lcVcxDir
else
	lcCodDir = addbs( tcCodDir )
endif

lnVcxs = aDir( laVcxs, lcVcxDir + "*.vcx" )
for lnI = 1 to lnVcxs
	lcVcx = laVcxs( lnI, 1 )
	lcCod = forceext( lcVcx, "prg" )
	lOneVcx( lcVcxDir + lcVcx, lcCodDir + lcCod )
endfor

return
**********************************************************************
function lOneVcx( tcVcx, tcCod )
* Process One VCX, create code as tcCod file

local ;
	lcTmpVcx
	
* VT
* Corrects work of ReFox 9 MMII 
UnRefoxOneVcx( tcVcx )

* clean up the vcx so that you are comparing apples and apples.
DO lOneVcx WITH tcVcx IN vcxcmt

_oBrowser.OpenFile( tcVcx )
_oBrowser.ExportClass( .f., tcCod )

return
**********************************************************************
Function UnRefoxOneVcx( tcVcx )
* Corrects work of ReFox 9 MMII 
* Process One VCX

Use (tcVcx) Exclusive

Replace All Methods With UnRefoxMth(Methods) ;
	For !Empty(Methods) and not Deleted()

USE
 
Return
**********************************************************************
Function UnRefoxMth( tcMth )
* Corrects work of ReFox 9 MMII 
* Parameters:
* tcMth: Methods from Method field of a vcx.

Local ;
	lnI, ;
	laLines[1], ;
	lcLine, ;
	lcMthCode, ;
	llInProcedure

lcMthCode = ""
llInProcedure = .F.
For lnI=1 to Alines( laLines, tcMth )
	lcLine = laLines[lnI]
  
	IF LEFT(lcLine, 9) = 'FUNCTION '
		lcLine = STRTRAN(lcLine, 'FUNCTION ', 'PROCEDURE ')
	ENDIF
	IF LEFT(lcLine, 7) = 'ENDFUNC'
		lcLine = STRTRAN(lcLine, 'ENDFUNC', 'ENDPROC')
	ENDIF
	IF NOT llInProcedure
		lcLine = STRTRAN(lcLine, '*', '')
	ENDIF

	Do Case
		Case lcLine = "PROCEDURE "
			llInProcedure = .T.

		Case lcLine = "ENDPROC"
			llInProcedure = .F.
	Endcase

	lcMthCode = lcMthCode + lcLine + CRLF

Endfor

Return lcMthCode
**********************************************************************
* eof: Vcxs2prg.prg




* Program VcxCmt.prg
* Adds {headers, returns, footers}
* to all the methods of all the classes in a dir.
* By CarlKarsten

#Define CRLF Chr(13)+Chr(10)

set safety off
set alternate to (program() + '.log')
set alternate on
set safety on

lOneDir(FullPath(''))
* lOneDir( "d:\vfe7\vfeframe\libs\" )
* lOneDir( "d:\dev\apps\dis\libs\", "*.vcx" )

* lOneDir( "D:\dev\util\pjx\trakproj\", "*.vcx" )
* lOneDir( "D:\dev\josh\skedstar", "*.scx" )

* lOneDir( "d:\vfe6\tools\builderb\" )
* lOneDir( "d:\vfe7\sample\libs\", "*.vcx")
* lOneDir( "d:\vfe7\ilibs\", "ip*vcx")
* lOneDir( "d:\vfe6\classes\" )
* lOneDir( "d:\vfe6\ilibs\", "*.vcx" )
* lOneDir( "d:\stonefield\sfreports", "SfReports.vcx" )
* lOneDir( "d:\stonefield\sfcommon\", "*.vcx" )
* lOneDir( "d:\stonefield\sfquery\", "*.vcx" )
* lOneDir( ".\", "STUD_ED.scx" )
* lOneDir( "d:\dev\tests\carcolors\ilibs\", "*.vcx" )
* lOneDir( ".\", "*.vcx" )
* lOneDir( "d:\vfe7\tools\pjxhookx\", "*.vcx" )


set alternate off
set alternate to
Return
**********************************************************************
Function lOneDir( tcVcxDir, tcVcxMask )
* Process all VCX's in tcVCXdir,

Local ;
	lcVcxDir, ;
	lcVcxMask, ;
	laVcxs(1), lnVcxs, lcVcx, ;
	lnI

lcVcxDir = Addbs( tcVcxDir )
lcVcxMask = Iif( Empty( tcVcxMask), "*.vcx", tcVcxMask )

lnVcxs = Adir( laVcxs, lcVcxDir + lcVcxMask )

If lnVcxs = 0
	? "No vcx's found in " + lcVcxDir
Endif

For lnI = 1 To lnVcxs
	lcVcx = laVcxs( lnI, 1 )
	lOneVcx( lcVcxDir + lcVcx )
Endfor

Return
**********************************************************************
Function lOneVcx( tcVcx )
* Process One VCX
* comments the method field of the vcx

? tcVcx

Use (tcVcx) Exclusive

* Browse FIELDS METHODS FOR !Empty( METHODS )

Try
	* add objectname and vcx to header, add return to end if needed.
*	Replace All Methods With ;
*		lCmtMth( Methods, Parent, objName, tcVcx ) For !Empty( Methods )
	Replace All Methods With ;
		lCmtMth( Methods, Parent, objName, tcVcx ) ;
		For !Empty( Methods ) and not Deleted()

	* lCmtMth( methods, objName, tcVcx ) for !empty( methods )

	* Sort Methods
*	Replace All Methods With ;
*		lSrtMth( Methods ) For !Empty( Methods )
	Replace All Methods With ;
		lSrtMth( Methods ) For !Empty( Methods ) and not Deleted()

	* This stopped working about the time vfp8 came out, but stopped in 7 too - i don't get it.
	* Sort reserved3 so that PdDn-ing thourgh methods are also sorted
	* replace reserved3 with laSrtMem( reserved3 ) ;
	*	for !empty( reserved3 )

	* "Fixes" some pointers that align methods in the class browser to the code.
	* This you need if you mess with the method field.
	USE
		
	Compile Classlib (tcVcx)

Catch To loError When loError.Message = "Variable 'METHODS' is not found."
	USE
		
Endtry

Return
**********************************************************************
Function lCmtMth( tcMth, tcParent, tcCls, tcVcx )
* function lCmtMth( tcMth, tcCls, tcVcx )

* Adds a comment to the top of each method: object::method {vcx}
* and a return at the end
* and a comment at the end too
* Parameters:
* tcMth: Methods from Method field of a vcx.
* tcCls: Class cotaining these methods -- from class field (trim(class))
* tcVcx: name of VCX file this class is in

* MODIFY CLASS ATTENDEESFORM OF "d:\dev\apps\cc\libs\aforms.vcx" method pgfAttendees.pagList.grdAttendees.enabled_assign
* Class attendeesform of d:\dev\apps\cc\libs\AFORMS.VCX Method grdAttendees.enabled_assign
Local ;
	llComment, ;		&& VT
	lnI, ;			&& VT
	llInProcedure, ;	&& VT
	laLins(1), lnLins, lcLin, ;
	lcLin2, ;		&& VT
	lcMthCod, ;
	llRetOk, ;
	lcFull, lcClass, lcObj, lcMethod, lcCurMethod

lcFull = Iif( Empty( tcParent ), "", tcParent + "." ) + tcCls
lcClass = Substr( lcFull, 1, At(".", lcFull+".")-1 )
lcObj = Iif( "."$lcFull, Substr( lcFull, At(".", lcFull)+1 ), "" )

* If we never find any code (including comments), no need for a return statement
llRetOk = .T.
llComment = .T.
llInProcedure = .F.
lcMthCod = ""
lnLins = Alines( laLins, tcMth )

* VT - 'For Each' has 255 limit
* For Each lcLin In laLins
For lnI=1 to lnLins
	lcLin = laLins[lnI]

	* correcting work of ReFox 9 MMII 
	IF LEFT(lcLin, 9) = 'FUNCTION '
		lcLin = STRTRAN(lcLin, 'FUNCTION ', 'PROCEDURE ')
	ENDIF
	IF LEFT(lcLin, 7) = 'ENDFUNC'
		lcLin = STRTRAN(lcLin, 'ENDFUNC', 'ENDPROC')
	ENDIF
	IF NOT llInProcedure
		lcLin = STRTRAN(lcLin, '*', '')
	ENDIF

	Do Case

		Case lcLin = "PROCEDURE "

			llInProcedure = .T.
			lcMethod = Iif( !Empty(lcObj), lcObj + ".", "" ) + Substr( lcLin, Len( "PROCEDURE" )+2 )
			Do Case
				Case Lower( Justext( tcVcx )) = "vcx"
					lcCurMethod = "** Modify Class "
				Case Lower( Justext( tcVcx )) = "scx"
					lcCurMethod = "** Modify Form "
			Endcase

			lcCurMethod = lcCurMethod ;
				+ lcClass + " of [" + tcVcx + "]" ;
				+ " Method " + lcMethod

			lcLin = lcLin + CRLF + lcCurMethod

		Case lcLin = "** Method: " And "::" $ lcLin And "{" $ lcLin And Lower( Right( lcLin, 5 ) ) = ".vcx}"
			* Eat this way OLD header line, a new header has been added.
			Loop

		Case lcLin = "** Class " And " of [" $ lcLin And " Method " $ lcLin
			* Eat this OLD header line, a new header has been added.
			Loop

		Case lcLin = "** Modify " And " of [" $ lcLin And " Method " $ lcLin
			* Eat this header line, a new header has been added.
			Loop

		Case lcLin = "ENDPROC"

			* We can rebuild it - it will be better than it was before.
			lcLin = ""

			* If the last non blank line was not "return", add a return.
			If !llRetOk
*			If !llRetOk and llComment
				? lcClass + " of [" + tcVcx + "]" + " Method " + lcMethod
				? 'Added "Return .t."'
				* lcLin = lcLin + "** next line (Return) added by " + PROGRAM(0) + CRLF
				lcLin = lcLin + "Return .t." + CRLF
			Endif
*			lcLin = lcLin + lcCurMethod + CRLF + CRLF
			lcLin = lcLin + lcCurMethod + CRLF
			lcLin = lcLin + "ENDPROC" + CRLF
			llInProcedure = .F.
			llComment = .T.

		Case Lower( Alltrim( Chrtran(lcLin, Chr(9), "" ) ) ) = "return"
			* found a return, so don't add one unless we find more code
			llRetOk = .T.

		Case !Empty( lcLin )

			* found code, so we need a return

			* I used to skip methods that only had a comment in them. That was wrong.
			* Even a comment in a method will cause
			* that method to get executed, not the code in the parent class.
			* You don't really see this in the debugger, because with no real code,
			* there is nothing for the debugger to step to, so it just exits the method.
			* So putting a return in the 'empty' method is a good idea so you can see
			* in the bugger which method executed

			lcLin2 = Lower( ltrim( Chrtran(lcLin, Chr(9), "" ) ) )
			do case
				case lcLin2 = '*'
				case lcLin2 = '&'+'&'
				case lcLin2 = 'note '
				otherwise
					llComment = .F.
			endcase

			llRetOk = .F.

	Endcase

	lcMthCod = lcMthCod + lcLin + CRLF

Endfor

Return lcMthCod
**********************************************************************
Function lSrtMth( tcMth )

* Sorts procedures file by procedure name

Local ;
	lnI, ;	&& VT
	lnSel, ;
	laLins(1), lnLins, lcLin, ;
	lcMthNam, ;
	lcMthCod, ;
	lcRet

lnSel = Select()

Create Cursor Mths ( cMthNam c(60), cMthCod m )
lnLins = Alines( laLins, tcMth )
lcMthCod = ""

* VT - 'For Each' has 255 limit
* For Each lcLin In laLins
For lnI=1 to lnLins
	lcLin = laLins[lnI]

	lcMthCod = lcMthCod + lcLin + CRLF
	Do Case
		Case lcLin = "PROCEDURE "
			lcMthNam = Substr( lcLin, Len( "PROCEDURE " ) )
		Case lcLin = "ENDPROC"
			Insert Into Mths Values ( lcMthNam, lcMthCod )
			lcMthCod = ""
	Endcase

Endfor

* Sort by proc name
* Index On cMthNam Tag cMthNam
Index On Upper(cMthNam) Tag cMthNam	&& VT

* Make a big string out of all the procs
lcRet = ""
Scan
	lcRet = lcRet + cMthCod
Endscan
Use

Select (lnSel)

Return lcRet
**********************************************************************
Function laSrtMem( tcMem )
	* Sort Memo

	Local ;
		lnMlns, laMLns(1), lcMln, ;
		lcRet

	* Put in array
	Alines( laMLns, tcMem )

	* Sort
	Asort( laMLns )

	* Put back into big string
	lcRet = ""
	For Each lcMln In laMLns
		lcRet = lcRet + lcMln + Chr(13) + Chr(10)
	Endfor

	Return lcRet
	**********************************************************************
	* eof: VcxCmt.prg



Contributor Carl Karsten Vlad Tokarev
Category Code Samples Category UDF
( Topic last updated: 2004.05.27 10:18:56 PM )