vfpxtab.prg

程序包 解压安装即可 很好用的 请大家放心用

*:*********************************************************************
*:
*: 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 = '亗儎厗噲墛媽帍悜挀敃枟槞殸、￥