Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Convert rows into columns
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Base de données, Tables, Vues, Index et syntaxe SQL
Divers
Thread ID:
00797678
Message ID:
00798220
Vues:
29
Thanks a lot, I´ll try this.


>The file is available as vfpxtab.prg here are the contents
>
>
>*:*********************************************************************
>*:
>*: Procedure file: VFPXTAB.PRG
>*:
>*:		System: GENXTAB
>*:		Author: Microsoft Corp.
>*:		Copyright (c) 1993,1994,1995 Microsoft Corp.
>*:		Version: 4.0
>*:
>*:*********************************************************************
>***********************************************************************
>*
>* Notes: This program is intended to be called by RQBE or a program
>*        generated by RQBE.  On entry, a table should be open in the
>*        current work area, and it should contain at most one record
>*        for each cell in a cross-tabulation.  This table *must* be in
>*        row order, or you will receive an "unexpected end of file"
>*        error when you run _GENXTAB.
>*
>*        The rowfld field in each record becomes the y-axis (rows) for
>*        a cross-tab and the colfld field becomes the x-axis (columns)
>*        The actual cross-tab results are saved to the database name
>*        specified by "outfname."
>*
>*        The basic strategy goes like this.  Produce an empty database
>*        with one field/column for each unique value of input field
>*        colfld, plus one additional field for input field rowfld values.
>*        This process determines the column headings in the database.
>*        Next fill in the rows, but only for the first field in the output
>*        database--the one that contains values for input field rowfld.
>*        At this point, we have column headings "across the top"
>*        and row identifiers "down the side."  Finally, look up
>*        the cell values for the row/column intersections and put
>*        them into the output database.
>*		
>* Parameters:
>*
>* 		 Parm1 - output file/cursor name (default "xtab.dbf")
>* 		 Parm2 - cursor only (default .F.)
>* 		 Parm3 - close input table after (default .T.)
>* 		 Parm4 - show thermometer (default .T.)
>* 		 Parm5 - row field 	(default 1)
>* 		 Parm6 - column field 	(default 2)
>* 		 Parm7 - data field 	(default 3)
>* 		 Parm8 - total rows	(default .F.)
>* 		 Parm9 - totaling options (0-sum, 1-count, 2-% of total)
>* 		 Parm10 - display Null values
>*
>* Calling example:
>*
>*		 oNewXtab=CREATE('genxtab','query',.T.,.T.,.T.,1,6,10,.T.,0)
>*		 oNewXtab.MakeXtab()
>*
>***********************************************************************
>#DEFINE	C_LOCATEDBF_LOC		"Input table:"
>#DEFINE	C_OUTPUT_LOC		"The input and output databases must be different."
>#DEFINE	C_NEED3FLDS_LOC		"Crosstab input databases require at least three fields"
>#DEFINE	C_EMPTYDBF_LOC		"Cannot prepare crosstab on empty database"
>#DEFINE	C_BADROWFLD_LOC		"The crosstab row field in the input; database cannot be a memo, general or picture  field."
>#DEFINE	C_BADCOLFLD_LOC		"The crosstab column field in the input; database cannot be a memo, general or picture field."
>#DEFINE	C_BADCELLFLD_LOC	"The crosstab cell field in the input; database cannot be a memo, general or picture field."
>#DEFINE	C_NOCOLS_LOC		"No columns found."
>#DEFINE	C_XSVALUES_LOC		"There are too many unique values for column field. The maximum is 254."
>#DEFINE	C_ENDOUTFILE_LOC	"Unexpected end of output file. The input file may be out of sequence. Check to see that Row field is ordered."
>#DEFINE	C_UNKNOWNFLD_LOC	"Unknown field type."
>#DEFINE	C_XTABTERM_LOC		"Cross tabulation process halted prematurely. Do you want to continue?"
>#DEFINE C_BADALIAS_LOC		"Please use a different alias from one of these reserved words -- THIS, THISFORM, THISFORMSET."
>
>#DEFINE ERR_LINE_LOC		"Line: "
>#DEFINE ERR_PROGRAM_LOC		"Program: "
>#DEFINE ERR_ERROR_LOC		"Error: "
>#DEFINE ERR_MESSAGE_LOC		"Message: "
>#DEFINE ERR_CODE_LOC		"Code: "
>
>#DEFINE	THERMCOMPLETE_LOC	"Complete."
>#DEFINE	C_THERM1_LOC		"Generating cross-tab output:"
>#DEFINE	C_THERM2_LOC		"Initializing cross-tab engine"
>#DEFINE	C_THERM3_LOC		"Reading input field information"
>#DEFINE	C_THERM4_LOC		"Creating output datasource"
>#DEFINE	C_THERM5_LOC		"Calculating cross-tab values"
>#DEFINE	C_THERM6_LOC		"Totaling output columns"
>
>#DEFINE	SUM_FIELDS			0
>#DEFINE	COUNT_FIELDS		1
>#DEFINE	PERCENT_FIELDS		2
>#DEFINE AVERAGE_FIELDS		3
>#DEFINE MAX_FIELDS			4
>#DEFINE MIN_FIELDS			5
>
>#DEFINE WIN32FONT			'MS Sans Serif'
>#DEFINE WIN95FONT			'Arial'
>#DEFINE DBCS_LOC 			"81 82 86 88"
>
>#DEFINE	C_SUMFIELD_LOC			"Total"
>#DEFINE	C_COUNTFIELD_LOC		"Count"
>#DEFINE	C_PERCENTFIELD_LOC		"Percent"
>
>
>LPARAMETER p1,p2,p3,p4,p5,p6,p7,p8,p9,p10
>* For background compatibility with FP2.x
>IF PARAMETERS() < 3
>	p3 = .T.
>ENDIF
>IF PARAMETERS() < 4
>	p4 = .T.
>ENDIF
>
>LOCAL liOldLanguageOptions
>liOldLanguageOptions = _vfp.LanguageOptions
>_vfp.LanguageOptions = 0	&& turn off strict memvar checking (jd 11/26/00)
>
>oNewXtab=CREATE("genxtab",m.p1,m.p2,m.p3,m.p4,m.p5,m.p6,m.p7,m.p8,m.p9,m.p10)
>IF TYPE("oNewXtab")="O"
>	oNewXtab.MakeXtab()
>ENDIF
>
>oNewXTab = .F.
>RELEASE oNewXTab
>
>_vfp.LanguageOptions = liOldLanguageOptions 	&& restore memvar checking value (jd 11/26/00)
>
>RETURN
>
>***********************************************************************
>***********************************************************************
>DEFINE CLASS genxtab AS custom
>
>	shownulls = .F.			&&controls display of NULLs
>
>	* Environment settings
>	xtalk_stat = ""
>	xsafe_stat = ""
>	xesc_stat = ""
>	mfieldsto = ""
>	fields = ""
>	udfparms = ""
>    mmacdesk = ""
>	in_esc = ""
>	outstem  = ""
>	setnull = ""
>	failxtab = .F.
>	setcompat = ""
>	
>	* Parameter defaults
>	outfname = "xtab.dbf"
>	cursonly = .F.
>	closeinput = .T.
>	therm_on = .T.
>	rowfld = 1
>	colfld = 2
>	cellfld = 3
>	xfoot = .F.
>	totaltype = 0
>	sumtype = 0
>	
>	* Default field names, captions and settings
>	char_blank = 	"C_BLANK"
>	date_blank = 	"D_BLANK"
>	null_field = 	"NULL"
>	sumtotalfld =	C_SUMFIELD_LOC
>	counttotalfld =	C_COUNTFIELD_LOC
>	perctotalfld =	C_PERCENTFIELD_LOC
>    cCountFldType   = "N"
>	nCountFldLen	= 4
>	nCountFldDec	= 0
>    cPercentFldType = "N"
>	nPercentFldLen	= 7
>	nPercentFldDec	= 3
>
>	* Misc thermometer stuff
>  	lHasModalFormOnTop = .F.
>  	cOldMessage = ""
>  	oThermRef = ""
>
>	* Map European characters to these
>	stdascii  = 'ueaaaaceeeiiAaEaAooouuyouaiounN'
>	badchars  = ""
>
>	iLanguageOptions = 0
>	
>*!*********************************************************************
>*!
>*!       PROCEDURE INIT
>*!
>*!*********************************************************************
>PROCEDURE INIT
>
>	PARAMETERS outfname, cursonly, closeinput, showtherm, rowfld, colfld, cellfld, xfoot, totaltype, shownulls
>
>	LOCAL cname,nParms,goodchars,i
>	m.nParms = PARAMETERS()
>	IF USED('THIS') .or. USED('THISFORM') .or. USED('THISFORMSET')
>		=MESSAGEBOX(C_BADALIAS_LOC)
>		RETURN .F.
>	ENDIF
>	THIS.save_env()
>	IF VERSION(3) $ DBCS_LOC
>		this.badchars = '/,-=:;!@#$%&*.<>()?[]\'+;
>		   '+'+CHR(34)+CHR(39)+" "
>	ELSE
>		this.badchars = '‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š ¡¢£¤¥/\,-=:;{}[]!@#$%^&*.<>()?'+;
>		   '+|€›œžŸ¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏ'+;
>		   'ÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþ'+CHR(34)+CHR(39)+" "
>	ENDIF
>
>	_vfp.LanguageOptions = 0
>
>	* Set parameters or use default values
>	
>	IF m.nParms > 0 AND TYPE("m.outfname") = "C"
>	   THIS.outfname = m.outfname
>	ENDIF
>	
>	* Default to creating the same kind of output as we got as input.
>	* If the input "database" is a cursor, make the output a cursor.
>	* If the input "database" is an actual database, make the output a table.
>    m.cname = THIS.justfname(DBF())
>    DO CASE
>    CASE EMPTY(m.cname)   && create a table if nothing is currently selected
>	      THIS.cursonly = .F.
>    CASE ATC(".DBF",THIS.outfname)#0
>	      THIS.cursonly = .F.
>    CASE ISDIGIT(LEFT(m.cname,1)) OR ATC(".TMP",m.cname)#0
>	      THIS.cursonly = .T.
>    CASE TYPE("m.cursonly") = "L"
>	      THIS.cursonly = m.cursonly
>    OTHERWISE
>		THIS.cursonly = .F.
>    ENDCASE
>    	
>	IF m.nParms > 2 AND TYPE("m.closeinput") = "L"
>	   * Close the input database
>	   THIS.closeinput = m.closeinput
>	ENDIF
>
>	IF m.nParms > 3 AND TYPE("m.showtherm ") = "L"
>	   * show the thermometer
>	   THIS.Therm_On = m.showtherm
>	ENDIF
>	
>	IF m.nParms > 4 AND TYPE("m.rowfld ") = "N"
>	   * the field position in the input database for the crosstab rows
>	   THIS.rowfld = m.rowfld
>	ENDIF
>	
>	IF m.nParms > 5  AND TYPE("m.colfld") = "N"
>	   * the field position in the input database for the crosstab columns
>	   THIS.colfld = m.colfld
>	ENDIF
>	
>	IF m.nParms > 6  AND TYPE("m.cellfld") = "N"
>	   * the field position in the input database for the crosstab cells
>	   THIS.cellfld = m.cellfld
>	ENDIF
>	
>	IF m.nParms  > 7 AND TYPE("m.xfoot") = "L"
>	   * Create a total field
>	   THIS.xfoot = m.xfoot
>	ENDIF
>
>	IF m.nParms  > 8 AND TYPE("m.totaltype") = "N"
>	   * Create a total field
>	   THIS.totaltype = m.totaltype
>	ENDIF
>
>	IF m.nParms  > 9 AND TYPE("m.shownulls") = "L"
>	   * Display nulls
>	   THIS.shownulls = m.shownulls
>	ENDIF
>	
>	IF THIS.shownulls
>		SET NULL ON
>	ELSE
>		SET NULL OFF
>	ENDIF
>
>	THIS.outfname = THIS.removequotes(THIS.outfname)
>	THIS.outstem = THIS.juststem(THIS.outfname)
>	
>	* Let's set the true bad characters which aren't allowed in fields
>	* Note: this will differ based on code page
>	m.goodchars=""
>	FOR i = 1 TO LEN(THIS.badchars)
>		IF ISALPHA(SUBSTR(THIS.badchars,m.i,1))
>			m.goodchars = m.goodchars + SUBSTR(THIS.badchars,m.i,1)
>		ENDIF
>	ENDFOR
>	THIS.badchars = CHRTRAN(m.THIS.badchars,m.goodchars,'')
>ENDPROC
>
>*!*********************************************************************
>*!
>*!       PROCEDURE save_env
>*!
>*!*********************************************************************
>PROCEDURE save_env
>	IF SET("TALK") = "ON"
>	   SET TALK OFF
>	   THIS.xtalk_stat = "ON"
>	ELSE
>	   THIS.xtalk_stat = "OFF"
>	ENDIF
>
>	THIS.iLanguageOptions = _vfp.LanguageOptions
>	
>	THIS.setcompat = SET("COMP")
>	SET COMP OFF
>	THIS.cOldMessage = SET("MESSAGE",1)
>	THIS.xsafe_stat = SET("SAFETY")
>	SET SAFETY OFF
>	THIS.xesc_stat = SET("ESCAPE")
>	SET ESCAPE ON
>	THIS.mfieldsto = SET("FIELDS",1)
>	THIS.fields = SET("FIELDS")
>	SET FIELDS TO
>	SET FIELDS OFF
>	THIS.udfparms = SET("UDFPARMS")
>	SET UDFPARMS TO VALUE
>	THIS.setnull = SET("NULL")
>
>	#IF "MAC" $ UPPER(VERSION(1))
>	   IF _MAC
>	      THIS.mmacdesk = SET("MACDESKTOP")
>		   SET MACDESKTOP ON
>	   ENDIF
>	#ENDIF
>
>	THIS.in_esc = ON('ESCAPE')
>ENDPROC
>
>*!*********************************************************************
>*!
>*!       PROCEDURE Destroy
>*!
>*!*********************************************************************
>PROCEDURE Destroy
>
>PRIVATE docancl,cTmpStr
>
>IF USED("XTABTEMP")
>   USE IN xtabtemp
>ENDIF
>
>IF FILE("xtabtemp.dbf")
>   DELETE FILE xtabtemp.dbf
>ENDIF
>IF EMPTY(THIS.cOldMessage)
>	SET MESSAGE TO
>ELSE
>	SET MESSAGE TO THIS.cOldMessage
>ENDIF
>m.cTmpStr = THIS.mfieldsto
>SET FIELDS TO &cTmpStr
>IF THIS.fields = "ON"
>   	SET FIELDS ON
>ELSE
>   	SET FIELDS OFF
>ENDIF
>
>cTmpStr=THIS.udfparms
>SET UDFPARMS TO &cTmpStr
>
>IF THIS.xsafe_stat = "ON"
>   SET SAFETY ON
>ENDIF
>IF THIS.xesc_stat = "ON"
>   SET ESCAPE ON
>ELSE
>   SET ESCAPE OFF
>ENDIF
>IF THIS.setnull = "OFF"
>	SET NULL OFF
>ELSE
>	SET NULL ON
>ENDIF
>IF THIS.xtalk_stat = "ON"
>   SET TALK ON
>ENDIF
>IF THIS.setcompat = "ON"
>	SET COMP ON
>ENDIF
>#IF "MAC" $ UPPER(VERSION(1))
>   IF _MAC
>   	m.cTmpStr = THIS.mmacdesk
>	   SET MACDESKTOP &cTmpStr
>   ENDIF
>#ENDIF
>
>cTmpStr = THIS.in_esc
>ON ESCAPE &cTmpStr
>
>IF THIS.failxtab	
>	THIS.outfname = ''
>	THIS.deactthermo()
>ENDIF
>
>_vfp.LanguageOptions = THIS.iLanguageOptions
>
>ENDPROC
>
>*!*********************************************************************
>*!
>*!       Function: MakeXTab()
>*!
>*!*********************************************************************
>PROCEDURE MakeXTab
>	* Set ON ESCAPE here
>	LOCAL oThisXtab
>	oThisXtab = THIS.Name+".esc_proc()"
>	ON ESCAPE &oThisXtab
>	
>	* Call main program
>	THIS.RunXTab()
>ENDPROC
>
>*!*********************************************************************
>*!
>*!       Function: RunXTab()
>*!
>*!*********************************************************************
>PROCEDURE RunXTab
>
>LOCAL dbfname,dbfstem,ok,cdec,i,tempdbf
>LOCAL numflds,rowfldname,colfldname,cellfldname
>LOCAL totfldname,gtotal,outf1name,f1,f2,f3
>LOCAL colcnt,coluniq,outarray,nTotFields,cSaveFld
>LOCAL sumallflds,RowFldType,cTmpField
>LOCAL nFldLen,cFldType,nFldDec,nAccumTot,nTmpTot
>DIMENSION colcnt[1],coluniq[1],outarray[1]
>
>m.dbfname = ALIAS()
>m.dbfstem = THIS.Juststem(m.dbfname)
>
>THIS.acttherm(C_THERM1_LOC)
>THIS.updtherm(5,C_THERM2_LOC)
>
>* Select one, if no database is open in the current workarea
>m.ok = .F.
>DO WHILE NOT m.ok
>   DO CASE
>   CASE EMPTY(m.dbfname)
>      m.dbfname = GETFILE('DBF',C_LOCATEDBF_LOC)
>      m.dbfstem = THIS.juststem(m.dbfname)
>      IF EMPTY(m.dbfname)
>         * User canceled out of dialog, so quit the program
>         THIS.failxtab = .T.
>		 RETURN
>      ENDIF
>   CASE FULLPATH(THIS.defaultext(m.dbfname,'DBF')) == ;
>         FULLPATH(THIS.defaultext(THIS.outfname,'DBF'))
>      THIS.ALERT(C_OUTPUT_LOC)
>      m.dbfname = ''
>   OTHERWISE
>      IF USED(m.dbfstem)
>         SELECT (m.dbfstem)
>      ELSE
>         SELECT 0
>         USE (m.dbfname) ALIAS (m.dbfstem)
>      ENDIF
>      IF FCOUNT() < 3
>         THIS.ALERT(C_NEED3FLDS_LOC)
>         m.dbfname = ''
>      ELSE
>         ok = .T.
>      ENDIF
>   ENDCASE
>ENDDO
>
>IF RECCOUNT() = 0
>    THIS.ALERT(C_EMPTYDBF_LOC)
>    THIS.failxtab = .T.
>	RETURN
>ENDIF
>
>* Gather information on the currently selected database fields
>
>DIMENSION inpfields[FCOUNT(),4]
>m.numflds = AFIELDS(inpfields)
>
>* Map the physical input database field to logical field positions
>
>m.rowfldname    = inpfields[THIS.rowfld,1]
>m.colfldname    = inpfields[THIS.colfld,1]
>m.cellfldname   = inpfields[THIS.cellfld,1]
>
>* None of these fields are allowed to be memo fields
>IF inpfields[THIS.rowfld,2] $ 'MGP'
>   THIS.ALERT(C_BADROWFLD_LOC)
>   THIS.failxtab = .T.
>   RETURN
>ENDIF
>IF inpfields[THIS.colfld,2] $ 'MGP'
>   THIS.ALERT(C_BADCOLFLD_LOC)
>   THIS.failxtab = .T.
>   RETURN
>ENDIF
>IF inpfields[THIS.cellfld,2] $ 'MGP'
>   THIS.ALERT(C_BADCELLFLD_LOC)
>   THIS.failxtab = .T.
>   RETURN
>ENDIF
>
>* Count the number of columns we need to create the cross tab.
>* This step could be combined with the following one so that there
>* would only be one SELECT operation performed.  It is coded in this
>* way to avoid running out of memory if there are an unexpectedly
>* large number of unique values of field 2 in the input database.
>
>THIS.updtherm(10,C_THERM3_LOC)
>tempdbf = IIF(UPPER(JUSTEXT(DBF()))#"TMP",DBF(),m.dbfname)
>SELECT COUNT(DISTINCT &colfldname) FROM (m.tempdbf) INTO ARRAY colcnt
>
>DO CASE
>CASE colcnt[1] > 254
>   THIS.ALERT(C_XSVALUES_LOC)
>   THIS.failxtab = .T.
>   RETURN
>CASE colcnt[1] = 0
>   THIS.ALERT(C_NOCOLS_LOC)
>   THIS.failxtab = .T.
>   RETURN
>ENDCASE
>
>* Get the number of decimal places in numeric fields
>* and extract all the unique values of colfldname
>IF inpfields[THIS.colfld,2] $ 'NFB'   && numeric or floating field
>   m.cdec = inpfields[THIS.colfld,4]
>   * Handle numbers separately to preserve correct sort order
>   SELECT DISTINCT &colfldname ;
>      FROM (m.tempdbf) INTO ARRAY coluniq
>   FOR i = 1 TO ALEN(coluniq)
>      coluniq[m.i] = THIS.mapname(coluniq[m.i],m.cdec)
>   ENDFOR
>ELSE        && non-numeric field
>   m.cdec = 0
>   * Create an array to hold the output database fields.
>   SELECT DISTINCT EVAL("THIS.mapname(&colfldname,m.cdec)") FROM (m.tempdbf) INTO ARRAY coluniq
>ENDIF
>
>THIS.updtherm(15,C_THERM3_LOC)
>
>* The field type, length and decimals in the output array control the
>* cross-tab cells
>IF !THIS.xfoot
>   DIMENSION outarray[ALEN(coluniq)+1,5]
>ELSE
>   DIMENSION outarray[ALEN(coluniq)+2,5]
>ENDIF
>
>* Field 1 in the output DBF holds the unique values of the row input field.
>* It is handled separately from the other fields, which take their names
>* from input database colfld and their parameters (e.g., length) from
>* input database cellfld.
>
>outarray[1,1] = ALLTRIM(THIS.mapname(inpfields[THIS.rowfld,1]))
>outarray[1,2] = inpfields[THIS.rowfld,2]						&& field type
>outarray[1,3] = inpfields[THIS.rowfld,3]			 			&& field length
>outarray[1,4] = inpfields[THIS.rowfld,4]						&& decimals
>outarray[1,5] = .T.												&& allow NULLs
>
>m.RowFldType = outarray[1,2]
>
>* Get field data type, width, and deci
>cFldType = inpfields[THIS.cellfld,2]
>nFldLen  = inpfields[THIS.cellfld,3]
>nFldDec  = inpfields[THIS.cellfld,4]
>
>* Set data types for data cells
>FOR i = 2 TO ALEN(coluniq) + 1
>   outarray[m.i,1] = ALLTRIM(THIS.mapname(coluniq[m.i-1],m.cdec))		&& field name
>   outarray[m.i,2] = m.cFldType 				                && field type
>   outarray[m.i,3] = m.nFldLen 									&& field length
>   outarray[m.i,4] = m.nFldDec 									&& decimals
>   outarray[m.i,5] = .T.										&& allow NULLs
>ENDFOR
>
>outarray[1,1] = THIS.CheckField(@coluniq,outarray[1,1])
>cSaveFld = outarray[1,1]
>
>* Create a field for the cross-footing, if that option was selected
>* By default, make sure we have a numeric field here
>
>* Check type of data field, and use count if not numeric.
>IF ATC(inpfields[THIS.cellfld,2],"NFYBI") = 0
>	THIS.totaltype = COUNT_FIELDS
>ENDIF
>
>IF THIS.xfoot
>   nTotFields = ALEN(coluniq)+2
>   DO CASE
>   CASE THIS.totaltype = COUNT_FIELDS
>   		* Since Max columns is 256, assume N (4)
>	   outarray[m.nTotFields,1] = THIS.CountTotalFld
>	   outarray[m.nTotFields,2] = THIS.cCountFldType    	&& field type
>	   outarray[m.nTotFields,3] = THIS.nCountFldLen    	&& field length
>	   outarray[m.nTotFields,4] = THIS.nCountFldDec    	&& field length
>   CASE THIS.totaltype = PERCENT_FIELDS
>   		* Percent of total, use three decimals
>   	   outarray[m.nTotFields,1] = THIS.perctotalfld
>	   outarray[m.nTotFields,2] = THIS.cPercentFldType	&& field type
>	   outarray[m.nTotFields,3] = THIS.nPercentFldLen    && field length
>  	   outarray[m.nTotFields,4] = THIS.nPercentFldDec    && decimals
>   OTHERWISE
>	   outarray[m.nTotFields,1] = THIS.sumtotalfld
>	   outarray[m.nTotFields,2] = inpfields[THIS.cellfld,2]		   && field type
>	   outarray[m.nTotFields,4] = inpfields[THIS.cellfld,4]		   && decimals
>	   IF ATC(inpfields[THIS.cellfld,2],"YB")#0
>		   outarray[m.nTotFields,3] = inpfields[THIS.cellfld,3]		&& field length	
>	   ELSE
>	   	  * Add a little extra space for calculations
>		   outarray[m.nTotFields,3] = MIN(inpfields[THIS.cellfld,3]+2,20)	&& field length
>	   ENDIF
>   ENDCASE
>   outarray[m.nTotFields,5] = .T.	&&allow nulls	
>
>   * Check for unique name
>   IF ALLTRIM(UPPER(outarray[m.nTotFields,1]))==ALLTRIM(UPPER(outarray[1,1]))
>   		DO CASE
>   		CASE LEN(ALLTRIM(outarray[1,1]))<9
>	   		outarray[m.nTotFields,1] = ALLTRIM(outarray[1,1])+"_1"
>		CASE RIGHT(outarray[1,1],2) = "_1"
>	   		outarray[m.nTotFields,1] = LEFT(outarray[1,1],8)+"_2"
>		OTHERWISE
>	   		outarray[m.nTotFields,1] = LEFT(outarray[1,1],8)+"_1"
>   		ENDCASE
>   ENDIF
>   outarray[m.nTotFields,1] = THIS.CheckField(@coluniq,outarray[m.nTotFields,1])
>ENDIF	
>
>* Make sure that the output file is not already in use somewhere
>IF USED(THIS.outstem)
>   SELECT (THIS.outstem)
>   USE
>ENDIF
>
>IF !THIS.cursonly
>   CREATE TABLE (THIS.outfname) FREE FROM ARRAY outarray
>   THIS.outstem = ALIAS()  &&ensure we have correct long name
>ELSE
>   CREATE CURSOR (THIS.outstem) FROM ARRAY outarray
>ENDIF
>
>THIS.updtherm(25,C_THERM3_LOC)
>
>* Get rid of the temporary arrays
>RELEASE outarray, coluniq, inpfields
>
>* -------------------------------------------------------------------------
>* Add output database rows and replace the first field
>* -------------------------------------------------------------------------
>
>* Select distinct rows into a table (instead of an array) so that
>* there can be lots of rows.  If we select into an array, we may
>* run out of RAM if there are many rows.
>
>SELECT DISTINCT &rowfldname. AS &cSaveFld. FROM (m.tempdbf) INTO TABLE xtabtemp
>THIS.updtherm(30,C_THERM4_LOC)
>
>SELECT (THIS.outstem)
>GO TOP
>APPEND FROM xtabtemp FIELD (FIELD(1))
>
>
>THIS.updtherm(35,C_THERM5_LOC)
>
>* -------------------------------------------------------------------------
>* Look up and replace the cell values
>* -------------------------------------------------------------------------
>*
>* This algorithm makes one pass through the input file, dropping its
>* values into the output file.  It exploits the fact that the output
>* file is known to be in row order.
>*
>
>* Start at the top of the output file
>SELECT (THIS.outstem)
>GOTO TOP
>outf1name = FIELD(1)
>
>* Start at the top of the input file
>SELECT (m.dbfstem)
>GOTO TOP
>
>SCAN
>
>   m.f1 = EVAL(m.rowfldname)                  		&& get next row value from input
>   m.f2 = THIS.mapname(EVAL(m.colfldname),m.cdec)   && get corresponding column value
>   m.f3 = EVAL(m.cellfldname)                 		&& get cell value
>
>   * Find the right row in the output file
>   SELECT (THIS.outstem)
>
>   GO TOP
>
>   DO WHILE !EOF()
>   	DO CASE
>   	CASE ISNULL(EVAL(outf1name)) AND ISNULL(m.f1)
>		EXIT
>   	CASE EVAL(outf1name) == m.f1
>   		EXIT
>   	ENDCASE
>      SKIP
>   ENDDO
>
>   IF EOF()
>      THIS.ALERT(C_ENDOUTFILE_LOC)
>      THIS.failxtab = .T.
>      RETURN
>   ENDIF
>
>	* SUM or replace for non numeric data types
>  	IF TYPE(m.f2) $ "NFYBI"
>  		IF ISNULL(&f2)
>  			nAccumTot = IIF(ISNULL(m.f3),.NULL.,m.f3)
>  		ELSE
>  			nAccumTot = &f2 + IIF(ISNULL(m.f3),0,m.f3)
>  		ENDIF
>   		REPLACE (m.f2) WITH m.nAccumTot
>	ELSE
>   		REPLACE (m.f2) WITH m.f3
>	ENDIF
>
>   SELECT (m.dbfstem)
>
>   * Map thermometer to remaining portion of display
>   DO CASE
>      CASE RECCOUNT() > 1000
>         IF RECNO() % 100 = 0
>            THIS.updtherm(INT(RECNO()/RECCOUNT()*60)+35,C_THERM5_LOC)
>         ENDIF
>      OTHERWISE
>         IF RECNO() % 10  = 0
>            THIS.updtherm(INT(RECNO()/RECCOUNT()*55)+35,C_THERM5_LOC)
>         ENDIF
>   ENDCASE
>ENDSCAN
>
>
>* Cross-foot the columns and put the results into the total field
>IF THIS.xfoot
>   THIS.updtherm(90,C_THERM6_LOC)
>   SELECT (THIS.outstem)
>   m.totfldname = FIELD(FCOUNT())
>   IF THIS.totaltype = PERCENT_FIELDS
>		* Need to get total here	
>		PRIVATE aSums,nFirstField
>		m.nFirstField = IIF(ATC(m.RowFldType,"NFIYB")=0,1,2)
>		SUM ALL TO ARRAY aSums
>		m.sumallflds = 0
>		FOR i = m.nFirstField TO (ALEN(aSums)-1)		&&skip last field which has totals
>			m.sumallflds = m.sumallflds + aSums[m.i]
>		ENDFOR
>   ENDIF
>   SCAN
>      * Sum the relevant fields
>      m.gtotal = .NULL.
>      FOR i = 2 TO FCOUNT() - 1
>		IF ISNULL(EVAL(FIELD(m.i)))
>			LOOP
>		ENDIF
>		IF ISNULL(m.gtotal) AND !ISNULL(EVAL(FIELD(m.i)))
>			gtotal = 0
>	  	ENDIF
>       	DO CASE
>	    CASE THIS.totaltype = COUNT_FIELDS
>			* Count values
>	    	IF THIS.shownulls
>		    	gtotal = m.gtotal + IIF(ISNULL(EVAL(FIELD(m.i))),0,1)
>	    	ELSE
>				cTmpField = field(m.i)
>		    	gtotal = m.gtotal + IIF(ISBLANK(&cTmpField),0,1)	
>	    	ENDIF
>	  	OTHERWISE
>			* SUM values
>			gtotal = m.gtotal + EVAL(FIELD(m.i))
>	  	ENDCASE
>	  ENDFOR
>	  IF THIS.totaltype = PERCENT_FIELDS
>	  		gtotal = IIF(m.sumallflds=0 OR ISNULL(m.gtotal) OR m.gtotal=0,0,ROUND(m.gtotal/m.sumallflds*100,THIS.nPercentFldDec))
>	  ENDIF
>      REPLACE (m.totfldname) WITH m.gtotal
>   ENDSCAN
>ENDIF
>
>THIS.updtherm(100)
>
>IF USED("XTABTEMP")
>   USE IN xtabtemp
>ENDIF
>
>IF FILE("xtabtemp.dbf")
>   DELETE FILE xtabtemp.dbf
>ENDIF
>
>* Close the input database
>IF THIS.closeinput
>   SELECT (m.dbfstem)
>   USE
>ENDIF
>
>* Leave the output database/cursor selected
>SELECT (THIS.outstem)
>GOTO TOP
>THIS.deactthermo()
>
>* Do closing housekeeping
>RETURN
>ENDPROC
>
>
>*!*********************************************************************
>*!
>*!       Function: MAPNAME()
>*!
>*!*********************************************************************
>FUNCTION mapname
>* Translate a field value of any type into a string containing a valid
>* field name.
>
>PARAMETER in_name, in_dec
>LOCAL retval
>
>IF PARAMETERS() = 1
>   m.in_dec = 0
>ENDIF
>DO CASE
>CASE ISNULL(m.in_name)
>	m.retval = THIS.null_field
>CASE TYPE("m.in_name") $ 'CM'
>   DO CASE
>   CASE EMPTY(m.in_name)
>      m.retval = THIS.char_blank
>   OTHERWISE
>   	  * We need to replace bad characters here with "_"
>      m.retval = CHRTRANC(m.in_name,THIS.badchars,REPLICATE("_",LEN(THIS.badchars)-1))
>
>      IF !ISALPHA(LEFT(m.retval,1))
>         m.retval = 'C_'+m.retval
>      ENDIF
>
>      IF !this.cursonly  && Leemi new code if a cursor, don't truncate
>		  * Now have to truncate to 10 bytes (not 10 chars)
>		  m.retval=SUBSTR(m.retval,1,10)	&& first 10 bytes
>		  IF LEN(RIGHTC(m.retval,1)) = 1 AND IsLeadByte(RIGHTC(m.retval,1))	&& last byte is Double byte
>			m.retval = SUBSTR(m.retval,1,9)
>		  ENDIF
>      ENDIF
>		
>   ENDCASE
>CASE TYPE("m.in_name") $ 'NFIYB'
>   m.retval = 'N_'+ALLTRIM(CHRTRANC(STR(m.in_name,8,MIN(in_dec,18)),'.',''))
>   m.retval = CHRTRANC(m.retval,'-,','__')
>CASE TYPE("m.in_name") $ 'DT'
>   DO CASE
>   CASE EMPTY(m.in_name)
>      m.retval = THIS.date_blank
>   OTHERWISE
>      m.retval = 'D_' + CHRTRANC(DTOS(m.in_name),THIS.badchars,REPLICATE("_",LEN(THIS.badchars)-1))
>   ENDCASE
>CASE TYPE("m.in_name") = 'L'
>   IF m.in_name = .T.
>      m.retval = 'T'
>   ELSE
>      m.retval = 'F'
>   ENDIF
>OTHERWISE
>   * Should never happen
>   THIS.alert(C_UNKNOWNFLD_LOC)
>   RETURN ""
>ENDCASE
>
>IF !THIS.Cursonly
>	RETURN PADR(UPPER(ALLTRIM(m.retval)),10)
>ELSE
>	RETURN PADR(UPPER(ALLTRIM(m.retval)),30)
>ENDIF
>
>ENDFUNC
>
>*!*********************************************************************
>*!
>*!      Procedure: CheckField
>*!
>*!*********************************************************************
>PROCEDURE CheckField
>PARAMETER aCheckArray,cCheckValue
>* Checks to see if field name is unique, else assigns a new one
>LOCAL oldExact,nTmpCnt,cTmpCntStr,cOldValue
>oldexact = SET("EXACT")
>SET EXACT ON
>IF LEN(ALLTRIM(m.cCheckValue)) > 10
>	cCheckValue = LEFT(ALLTRIM(m.cCheckValue),10)
>ENDIF
>cOldValue = m.cCheckValue
>nTmpCnt = 1
>DO WHILE ASCAN(aCheckArray,m.cCheckValue)#0
>	cTmpCntStr = "_"+ALLTRIM(STR(m.nTmpCnt))
>	cCheckValue = LEFT(ALLTRIM(m.cOldValue),10-LEN(m.cTmpCntStr)) + m.cTmpCntStr
>	nTmpCnt = m.nTmpCnt + 1
>ENDDO
>SET EXACT &oldexact
>RETURN m.cCheckValue
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: ERROR
>*!
>*!*********************************************************************
>PROCEDURE ERROR
>PARAMETERS nError,cMethod,nLine
>THIS.alert(ERR_LINE_LOC+ALLTRIM(STR(m.nLine))+CHR(13) ;
>   +ERR_PROGRAM_LOC+m.cMethod+CHR(13) ;
>   +ERR_ERROR_LOC+ALLTRIM(STR(nError))+CHR(13) ;
>   +ERR_MESSAGE_LOC+MESSAGE()+CHR(13);
>   +ERR_CODE_LOC+MESSAGE(1))
>
>   THIS.failxtab = .T.
>   RETURN TO MakeXtab
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: ALERT
>*!
>*!*********************************************************************
>PROCEDURE alert
>LPARAMETERS strg
>=MESSAGEBOX(m.strg)
>RETURN
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: ESC_PROC
>*!
>*!*********************************************************************
>PROCEDURE esc_proc
>	CLEAR TYPEAHEAD
>    IF MESSAGEBOX(C_XTABTERM_LOC,36) = 6
>		RETURN
>    ELSE
>	    THIS.failxtab = .T.
>		RETURN TO MakeXtab
>    ENDIF
>ENDPROC
>
>*!*****************************************************************************
>*!
>*!      Procedure: PARTIALFNAME
>*!
>*!*****************************************************************************
>FUNCTION partialfname
>PARAMETER m.filname, m.fillen
>* Return a filname no longer than m.fillen characters.  Take some chars
>* out of the middle if necessary.  No matter what m.fillen is, this function
>* always returns at least the file stem and extension.
>PRIVATE m.bname, m.elipse
>m.elipse = "..." + c_pathsep
>m.bname = THIS.justfname(m.filname)
>DO CASE
>CASE LEN(m.filname) <= m.fillen
>   RETURN filname
>CASE LEN(m.bname) + LEN(m.elipse) >= m.fillen
>   RETURN m.bname
>OTHERWISE
>   m.remain = MAX(m.fillen - LEN(m.bname) - LEN(m.elipse), 0)
>   RETURN LEFT(THIS.justpath(m.filname),remain)+m.elipse+m.bname
>ENDCASE
>ENDFUNC
>
>*!*****************************************************************************
>*!
>*!      Procedure: removequotes
>*!
>*!*****************************************************************************
>FUNCTION removequotes
>PARAMETER m.fname
>PRIVATE m.leftchar, m.rightchar
>m.fname = ALLTRIM(m.fname)
>m.leftchar = LEFT(m.fname,1)
>m.rightchar = RIGHT(m.fname, 1)
>
>IF m.leftchar = '"' AND m.rightchar = '"'    ;
>	OR m.leftchar = "'" AND m.rightchar = "'"  ;
>	OR m.leftchar = '[' AND m.rightchar = ']'
>		RETURN SUBSTR(m.fname, 2, LEN(m.fname) - 2)
>ELSE
>   RETURN m.fname		
>ENDIF
>ENDFUNC
>
>*!*********************************************************************
>*!
>*!       Function: JUSTSTEM()
>*!
>*!*********************************************************************
>FUNCTION juststem
>* Return just the stem name from "filname"
>PARAMETERS filname
>PRIVATE ALL
>IF RAT('\',m.filname) > 0
>   m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255)
>ENDIF
>IF RAT(':',m.filname) > 0
>   m.filname = SUBSTR(m.filname,RAT(':',m.filname)+1,255)
>ENDIF
>IF RAT('.',m.filname) > 0
>   m.filname = SUBSTR(m.filname,1,RAT('.',m.filname)-1)
>ENDIF
>RETURN ALLTRIM(UPPER(m.filname))
>ENDFUNC
>
>*!*********************************************************************
>*!
>*!      Procedure: FORCEEXT
>*!
>*!*********************************************************************
>FUNCTION forceext
>* Force the extension of "filname" to be whatever ext is.
>PARAMETERS filname,ext
>PRIVATE ALL
>IF SUBSTR(m.ext,1,1) = "."
>   m.ext = SUBSTR(m.ext,2,3)
>ENDIF
>
>m.pname = THIS.justpath(m.filname)
>m.filname = THIS.justfname(UPPER(ALLTRIM(m.filname)))
>IF RAT('.',m.filname) > 0
>   m.filname = SUBSTR(m.filname,1,RAT('.',m.filname)-1) + '.' + m.ext
>ELSE
>   m.filname = m.filname + '.' + m.ext
>ENDIF
>RETURN THIS.addbs(m.pname) + m.filname
>ENDFUNC
>
>*!*********************************************************************
>*!
>*!       Function: DEFAULTEXT()
>*!
>*!*********************************************************************
>FUNCTION defaultext
>* Add a default extension to "filname" if it doesn't have one already
>PARAMETERS filname,ext
>PRIVATE ALL
>IF SUBSTR(ext,1,1) = "."
>   m.ext = SUBSTR(m.ext,2,3)
>ENDIF
>
>m.pname = THIS.justpath(m.filname)
>m.filname = THIS.justfname(UPPER(ALLTRIM(m.filname)))
>IF !EMPTY(m.filname) AND AT('.',m.filname) = 0
>   m.filname = m.filname + '.' + m.ext
>   RETURN THIS.addbs(m.pname) + m.filname
>ELSE
>   RETURN filname
>ENDIF
>ENDFUNC
>
>*!*********************************************************************
>*!
>*!       Function: JUSTFNAME()
>*!
>*!*********************************************************************
>FUNCTION justfname
>* Return just the filename (i.e., no path) from "filname"
>PARAMETERS filname
>PRIVATE ALL
>IF RAT('\',m.filname) > 0
>   m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255)
>ENDIF
>IF RAT(':',m.filname) > 0
>   m.filname = SUBSTR(m.filname,RAT(':',m.filname)+1,255)
>ENDIF
>RETURN ALLTRIM(UPPER(m.filname))
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: JUSTPATH
>*!
>*!*********************************************************************
>FUNCTION justpath
>* Return just the path name from "filname"
>PARAMETERS m.filname
>PRIVATE ALL
>m.filname = ALLTRIM(UPPER(m.filname))
>m.pathsep = IIF(_MAC,":", "\")
>IF _MAC
>   m.found_it = .F.
>   m.maxchar = max(RAT("\", m.filname), RAT(":", m.filname))
>   IF m.maxchar > 0
>      m.filname = SUBSTR(m.filname,1,m.maxchar)
>      IF RIGHT(m.filname,1) $ ":\" AND LEN(m.filname) > 1 ;
>            AND !(SUBSTR(m.filname,LEN(m.filname)-1,1)  $ ":\")
>         m.filname = SUBSTR(m.filname,1,LEN(m.filname)-1)
>      ENDIF
>      RETURN m.filname
>   ENDIF
>ELSE
>   IF m.pathsep $ filname
>      m.filname = SUBSTR(m.filname,1,RAT(m.pathsep,m.filname))
>      IF RIGHT(m.filname,1) = m.pathsep AND LEN(m.filname) > 1 ;
>            AND SUBSTR(m.filname,LEN(m.filname)-1,1) <> m.pathsep
>         m.filname = SUBSTR(m.filname,1,LEN(m.filname)-1)
>      ENDIF
>      RETURN m.filname
>   ENDIF
>ENDIF
>RETURN ''
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: ADDBS
>*!
>*!*********************************************************************
>FUNCTION addbs
>* Add a backslash to a path name, if there isn't already one there
>PARAMETER pathname
>PRIVATE ALL
>m.pathname = ALLTRIM(UPPER(m.pathname))
>IF !(RIGHT(m.pathname,1) $ '\:') AND !EMPTY(m.pathname)
>   m.pathname = m.pathname + IIF(_MAC,":",'\')
>ENDIF
>RETURN m.pathname
>ENDPROC
>
>
>*!*********************************************************************
>*!
>*!      Procedure: HasModalForm
>*!
>*!*********************************************************************
>PROCEDURE HasModalForm
>* Tests to see if a modal form is active and uses status bar
>* Note: This is commented out, however, if you prefer to use the status bar
>* remove the following line
>RETURN .F.
>LOCAL i
>FOR i = 1 TO _SCREEN.FormCount
>	IF _Screen.Forms[m.i].Windowtype = 1 OR ;
>	 (TYPE("_Screen.Forms[m.i].Parent.Windowtype")="N" AND ;
>	_Screen.Forms[m.i].Parent.Windowtype = 1)
>		RETURN .T.
>		EXIT
>	ENDIF
>ENDFOR
>RETURN .F.
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: ActTherm
>*!
>*!*********************************************************************
>PROCEDURE ActTherm
>PARAMETER prompt
>IF !THIS.therm_on
>	RETURN
>ENDIF
>IF VARTYPE(m.prompt)#"C"
>	prompt=""
>ENDIF
>* Test to see if we have a modal form up which prevents Therm window from being visible.
>IF THIS.HasModalForm()
>	THIS.lHasModalFormOnTop = .T.
>	RETURN
>ENDIF
>THIS.oThermRef = CREATEOBJECT("thermometer",m.prompt)
>THIS.oThermRef.Show()
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: updtherm
>*!
>*!*********************************************************************
>PROCEDURE updtherm
>LPARAMETER Percent,cTask
>IF !THIS.therm_on
>	RETURN
>ENDIF
>IF THIS.lHasModalFormOnTop
>	SET MESSAGE TO C_THERM1_LOC+ALLTRIM(STR(m.percent))+"%"
>	RETURN
>ENDIF
>IF m.Percent = 100
>	THIS.oThermRef.Complete()
>ELSE
>	THIS.oThermRef.Update(m.Percent,cTask)
>ENDIF
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: deactthermo
>*!
>*!*********************************************************************
>PROCEDURE deactthermo
>	IF !THIS.therm_on
>		RETURN
>	ENDIF
>	IF THIS.lHasModalFormOnTop
>		RETURN
>	ENDIF	
>	IF TYPE("THIS.oThermRef") = "O"
>	   THIS.oThermRef.Release()
>	ENDIF
>ENDPROC
>
>ENDDEFINE
>
>
>***********************************************************************
>***********************************************************************
>DEFINE CLASS thermometer AS form
>
>	Top = 196
>	Left = 142
>	Height = 88
>	Width = 356
>	AutoCenter = .T.
>	BackColor = RGB(192,192,192)
>	BorderStyle = 0
>	Caption = ""
>	Closable = .F.
>	ControlBox = .F.
>	MaxButton = .F.
>	MinButton = .F.
>	Movable = .F.
>	AlwaysOnTop = .F.
>	ipercentage = 0
>	ccurrenttask = ''
>	shpthermbarmaxwidth = 322
>	cthermref = ""
>	Name = "thermometer"
>
>	ADD OBJECT shape10 AS shape WITH ;
>		BorderColor = RGB(128,128,128), ;
>		Height = 81, ;
>		Left = 3, ;
>		Top = 3, ;
>		Width = 1, ;
>		Name = "Shape10"
>
>
>	ADD OBJECT shape9 AS shape WITH ;
>		BorderColor = RGB(128,128,128), ;
>		Height = 1, ;
>		Left = 3, ;
>		Top = 3, ;
>		Width = 349, ;
>		Name = "Shape9"
>
>
>	ADD OBJECT shape8 AS shape WITH ;
>		BorderColor = RGB(255,255,255), ;
>		Height = 82, ;
>		Left = 352, ;
>		Top = 3, ;
>		Width = 1, ;
>		Name = "Shape8"
>
>
>	ADD OBJECT shape7 AS shape WITH ;
>		BorderColor = RGB(255,255,255), ;
>		Height = 1, ;
>		Left = 3, ;
>		Top = 84, ;
>		Width = 350, ;
>		Name = "Shape7"
>
>
>	ADD OBJECT shape6 AS shape WITH ;
>		BorderColor = RGB(128,128,128), ;
>		Height = 86, ;
>		Left = 354, ;
>		Top = 1, ;
>		Width = 1, ;
>		Name = "Shape6"
>
>
>	ADD OBJECT shape4 AS shape WITH ;
>		BorderColor = RGB(128,128,128), ;
>		Height = 1, ;
>		Left = 1, ;
>		Top = 86, ;
>		Width = 354, ;
>		Name = "Shape4"
>
>
>	ADD OBJECT shape3 AS shape WITH ;
>		BorderColor = RGB(255,255,255), ;
>		Height = 85, ;
>		Left = 1, ;
>		Top = 1, ;
>		Width = 1, ;
>		Name = "Shape3"
>
>
>	ADD OBJECT shape2 AS shape WITH ;
>		BorderColor = RGB(255,255,255), ;
>		Height = 1, ;
>		Left = 1, ;
>		Top = 1, ;
>		Width = 353, ;
>		Name = "Shape2"
>
>
>	ADD OBJECT shape1 AS shape WITH ;
>		BackStyle = 0, ;
>		Height = 88, ;
>		Left = 0, ;
>		Top = 0, ;
>		Width = 356, ;
>		Name = "Shape1"
>
>
>	ADD OBJECT shape5 AS shape WITH ;
>		BorderStyle = 0, ;
>		FillColor = RGB(192,192,192), ;
>		FillStyle = 0, ;
>		Height = 15, ;
>		Left = 17, ;
>		Top = 47, ;
>		Width = 322, ;
>		Name = "Shape5"
>
>
>	ADD OBJECT lbltitle AS label WITH ;
>		FontName = WIN32FONT, ;
>		FontSize = 8, ;
>		BackStyle = 0, ;
>		BackColor = RGB(192,192,192), ;
>		Caption = "", ;
>		Height = 16, ;
>		Left = 18, ;
>		Top = 14, ;
>		Width = 319, ;
>		WordWrap = .F., ;
>		Name = "lblTitle"
>
>
>	ADD OBJECT lbltask AS label WITH ;
>		FontName = WIN32FONT, ;
>		FontSize = 8, ;
>		BackStyle = 0, ;
>		BackColor = RGB(192,192,192), ;
>		Caption = "", ;
>		Height = 16, ;
>		Left = 18, ;
>		Top = 27, ;
>		Width = 319, ;
>		WordWrap = .F., ;
>		Name = "lblTask"
>
>
>	ADD OBJECT shpthermbar AS shape WITH ;
>		BorderStyle = 0, ;
>		FillColor = RGB(128,128,128), ;
>		FillStyle = 0, ;
>		Height = 16, ;
>		Left = 17, ;
>		Top = 46, ;
>		Width = 0, ;
>		Name = "shpThermBar"
>
>
>	ADD OBJECT lblpercentage AS label WITH ;
>		FontName = WIN32FONT, ;
>		FontSize = 8, ;
>		BackStyle = 0, ;
>		Caption = "0%", ;
>		Height = 13, ;
>		Left = 170, ;
>		Top = 47, ;
>		Width = 16, ;
>		Name = "lblPercentage"
>
>
>	ADD OBJECT lblpercentage2 AS label WITH ;
>		FontName = WIN32FONT, ;
>		FontSize = 8, ;
>		BackColor = RGB(0,0,255), ;
>		BackStyle = 0, ;
>		Caption = "Label1", ;
>		ForeColor = RGB(255,255,255), ;
>		Height = 13, ;
>		Left = 170, ;
>		Top = 47, ;
>		Width = 0, ;
>		Name = "lblPercentage2"
>
>
>	ADD OBJECT shape11 AS shape WITH ;
>		BorderColor = RGB(128,128,128), ;
>		Height = 1, ;
>		Left = 16, ;
>		Top = 45, ;
>		Width = 322, ;
>		Name = "Shape11"
>
>
>	ADD OBJECT shape12 AS shape WITH ;
>		BorderColor = RGB(255,255,255), ;
>		Height = 1, ;
>		Left = 16, ;
>		Top = 61, ;
>		Width = 323, ;
>		Name = "Shape12"
>
>
>	ADD OBJECT shape13 AS shape WITH ;
>		BorderColor = RGB(128,128,128), ;
>		Height = 16, ;
>		Left = 16, ;
>		Top = 45, ;
>		Width = 1, ;
>		Name = "Shape13"
>
>
>	ADD OBJECT shape14 AS shape WITH ;
>		BorderColor = RGB(255,255,255), ;
>		Height = 17, ;
>		Left = 338, ;
>		Top = 45, ;
>		Width = 1, ;
>		Name = "Shape14"
>
>
>	ADD OBJECT lblescapemessage AS label WITH ;
>		FontBold = .F., ;
>		FontName = WIN32FONT, ;
>		FontSize = 8, ;
>		Alignment = 2, ;
>		BackStyle = 0, ;
>		BackColor = RGB(192,192,192), ;
>		Caption = "", ;
>		Height = 14, ;
>		Left = 17, ;
>		Top = 68, ;
>		Width = 322, ;
>		WordWrap = .F., ;
>		Name = "lblEscapeMessage"
>
>
>*!*********************************************************************
>*!
>*!      Procedure: complete
>*!
>*!*********************************************************************
>PROCEDURE complete
>		* This is the default complete message
>		parameters m.cTask
>		private iSeconds
>		if parameters() = 0
>			m.cTask = THERMCOMPLETE_LOC
>		endif
>		this.Update(100,m.cTask)
>ENDPROC
>
>
>*!*********************************************************************
>*!
>*!      Procedure: update
>*!
>*!*********************************************************************
>PROCEDURE update
>		* m.iProgress is the percentage complete
>		* m.cTask is displayed on the second line of the window
>
>		parameters iProgress,cTask
>
>		if parameters() >= 2 .and. type('m.cTask') = 'C'
>			* If we're specifically passed a null string, clear the current task,
>			* otherwise leave it alone
>			this.cCurrentTask = m.cTask
>		endif
>		
>		if ! this.lblTask.Caption == this.cCurrentTask
>			this.lblTask.Caption = this.cCurrentTask
>		endif
>
>		m.iPercentage = m.iProgress
>		m.iPercentage = min(100,max(0,m.iPercentage))
>		
>		if m.iPercentage = this.iPercentage
>			RETURN
>		endif
>		
>		if len(alltrim(str(m.iPercentage,3)))<>len(alltrim(str(this.iPercentage,3)))
>			iAvgCharWidth=fontmetric(6,this.lblPercentage.FontName, ;
>				this.lblPercentage.FontSize, ;
>				iif(this.lblPercentage.FontBold,'B','')+ ;
>				iif(this.lblPercentage.FontItalic,'I',''))
>			this.lblPercentage.Width=txtwidth(alltrim(str(m.iPercentage,3)) + '%', ;
>				this.lblPercentage.FontName,this.lblPercentage.FontSize, ;
>				iif(this.lblPercentage.FontBold,'B','')+ ;
>				iif(this.lblPercentage.FontItalic,'I','')) * iAvgCharWidth
>			this.lblPercentage.Left=int((this.shpThermBarMaxWidth- ;
>				this.lblPercentage.Width) / 2)+this.shpThermBar.Left-1
>			this.lblPercentage2.Left=this.lblPercentage.Left
>		endif
>		this.shpThermBar.Width = int((this.shpThermBarMaxWidth)*m.iPercentage/100)
>		this.lblPercentage.Caption = alltrim(str(m.iPercentage,3)) + '%'
>		this.lblPercentage2.Caption = this.lblPercentage.Caption
>		if this.shpThermBar.Left + this.shpThermBar.Width -1 >= ;
>			this.lblPercentage2.Left
>			if this.shpThermBar.Left + this.shpThermBar.Width - 1 >= ;
>				this.lblPercentage2.Left + this.lblPercentage.Width - 1
>				this.lblPercentage2.Width = this.lblPercentage.Width
>			else
>				this.lblPercentage2.Width = ;
>					this.shpThermBar.Left + this.shpThermBar.Width - ;
>					this.lblPercentage2.Left - 1
>			endif
>		else
>			this.lblPercentage2.Width = 0
>		endif
>		this.iPercentage = m.iPercentage
>ENDPROC
>
>*!*********************************************************************
>*!
>*!      Procedure: Init
>*!
>*!*********************************************************************
>PROCEDURE Init
>		* m.cTitle is displayed on the first line of the window
>		* m.iInterval is the frequency used for updating the thermometer
>		parameters cTitle, iInterval
>		this.lblTitle.Caption = iif(empty(m.cTitle),'',m.cTitle)
>		this.shpThermBar.FillColor = rgb(128,128,128)
>		local cColor
>
>		* Check to see if the fontmetrics for MS Sans Serif matches
>		* those on the system developed. If not, switch to Arial.
>		* The RETURN value indicates whether the font was changed.
>		if fontmetric(1, WIN32FONT, 8, '') <> 13 .or. ;
>			fontmetric(4, WIN32FONT, 8, '') <> 2 .or. ;
>			fontmetric(6, WIN32FONT, 8, '') <> 5 .or. ;
>			fontmetric(7, WIN32FONT, 8, '') <> 11
>			this.SetAll('FontName', WIN95FONT)
>		endif
>
>		m.cColor = rgbscheme(1, 2)
>		m.cColor = 'rgb(' + substr(m.cColor, at(',', m.cColor, 3) + 1)
>		this.BackColor = &cColor
>		this.Shape5.FillColor = &cColor
>ENDPROC
>
>ENDDEFINE
>
>
>>Can you give me an URL or something to find it?
>>10x!
>>
>>>Try xtab program.
>>>
>>>Aashish
>>>
>>>>Hi y'all.
>>>>I need to obtain a cursor with one column for each row corresponding to a code in a master tabla, let me explain further..
>>>>There is a parent table and a child table, both have a field called "cedula" which i use to join them, the chilt table has another fiel called "curso" which contains the code of an item, what i need is to obtain a cursor with the following structure:
>>>>
>>>>cedula,curso1,curso2,curso3,curso4......cursoN
>>>>
>>>>I made a program that works with macro substitution and creating N cursors which i join at the end, but i think there must be a better way..
>>>>
>>>>Is that possible?? how??
>>>>
>>>>Thanks in advance.
>>>>
>>>>jonamart@cantv.net
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform