Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Print Dialog Box
Message
 
À
18/08/2005 08:38:04
Steve Jones
Business Systems Services Uk Ltd
Swansea, Royaume Uni
Information générale
Forum:
Visual FoxPro
Catégorie:
Autre
Versions des environnements
Visual FoxPro:
VFP 6 SP5
Divers
Thread ID:
01041633
Message ID:
01042190
Vues:
29
>Thanks Borislav,
>
>I believe so. If you are in an office application and go file->print you will have the option to print to file on the print dialog box. I think when this is selected it will produce a file which would normally have been sent to printer, containing printer commands etc.
>

Steve,
Here the changes I made in thge form I posted the link to. I think it should works for you:
**************************************************
*-- Form:         reportformprompt (d:\tte\reportformprompt.scx)
*-- ParentClass:  form
*-- BaseClass:    form
*-- Time Stamp:   08/19/05 11:06:00 AM
*
#INCLUDE "d:\tte\foxwingdi.h"
*
DEFINE CLASS reportformprompt AS form


	Height = 310
	Width = 444
	DoCreate = .T.
	AutoCenter = .T.
	BorderStyle = 2
	Caption = "Print Setup"
	ControlBox = .F.
	MaxButton = .F.
	MinButton = .F.
	WindowType = 1
	AlwaysOnTop = .T.
	*-- Printer orientation.
	printerorientation = 0
	*-- Number of copies to print.
	printercopies = 0
	*-- Paper size.
	printerpapersize = 0
	*-- Paper source.
	printerpapersource = ""
	*-- Printer name.
	printername = ""
	*-- Number of available printers.
	prncount = 0
	*-- Delimited list of printers to be excluded from reports.
	prnexclusions = "Rendering Subsystem"
	*-- Temporary report file.
	rpttmpfile = ""
	*-- Report extension, FRX or LBX.
	rptext = "FRX"
	cadditionalclauses = ""
	*-- User defined FOR and WHILE clauses to be passed to the report.
	cforwhile = ""
	*-- User defined scope to be passed to the report.
	cscope = ""
	*-- The "5" in "5.0"
	nmajorversion = 0
	*-- The "0" in "5.0"
	nminorversion = 0
	*-- Build number
	nbuild = 0
	*-- Windows platform type
	cplatform = ""
	*-- Service Pack information
	ccsdversion = ""
	*-- Are the proerties valid, or did GetVersionEx() fail for some reason?
	lvalid = .F.
	Name = "REPORTFORMPROMPT"

	*-- Report path
	rptpath = .F.

	*-- Array of available printers used to populate the name dropdown.
	DIMENSION prnarray[1,1]

	*-- List of paper sizes used to populate the Paper Size dropdown.
	DIMENSION prnpaper[1,1]

	*-- List of paper sources used to populate the Paper Source dropdown.
	DIMENSION prnbins[1,1]


	ADD OBJECT shape4 AS shape WITH ;
		Top = 192, ;
		Left = 240, ;
		Height = 72, ;
		Width = 192, ;
		BackStyle = 0, ;
		SpecialEffect = 0, ;
		Name = "Shape4"


	ADD OBJECT shape5 AS shape WITH ;
		Top = 192, ;
		Left = 12, ;
		Height = 72, ;
		Width = 216, ;
		BackStyle = 0, ;
		SpecialEffect = 0, ;
		Name = "Shape5"


	ADD OBJECT shape3 AS shape WITH ;
		Top = 96, ;
		Left = 240, ;
		Height = 85, ;
		Width = 192, ;
		BackStyle = 0, ;
		SpecialEffect = 0, ;
		Name = "Shape3"


	ADD OBJECT shape2 AS shape WITH ;
		Top = 96, ;
		Left = 12, ;
		Height = 84, ;
		Width = 216, ;
		BackStyle = 0, ;
		SpecialEffect = 0, ;
		Name = "Shape2"


	ADD OBJECT shape1 AS shape WITH ;
		Top = 12, ;
		Left = 12, ;
		Height = 68, ;
		Width = 420, ;
		BackStyle = 0, ;
		SpecialEffect = 0, ;
		Name = "Shape1"


	ADD OBJECT label3 AS label WITH ;
		FontName = "MS Sans Serif", ;
		Caption = "Where:", ;
		Height = 17, ;
		Left = 26, ;
		Top = 55, ;
		Width = 40, ;
		TabIndex = 4, ;
		Name = "Label3"


	ADD OBJECT label6 AS label WITH ;
		FontName = "MS Sans Serif", ;
		Caption = "\<Source", ;
		Height = 15, ;
		Left = 24, ;
		Top = 145, ;
		Width = 42, ;
		TabIndex = 9, ;
		Name = "Label6"


	ADD OBJECT label7 AS label WITH ;
		FontName = "MS Sans Serif", ;
		Caption = "Si\<ze", ;
		Height = 15, ;
		Left = 24, ;
		Top = 120, ;
		Width = 42, ;
		TabIndex = 7, ;
		Name = "Label7"


	ADD OBJECT label8 AS label WITH ;
		AutoSize = .T., ;
		FontName = "MS Sans Serif", ;
		Caption = "Number of \<copies", ;
		Height = 15, ;
		Left = 258, ;
		Top = 222, ;
		Width = 85, ;
		TabIndex = 20, ;
		Name = "Label8"


	ADD OBJECT label11 AS label WITH ;
		AutoSize = .T., ;
		FontName = "MS Sans Serif", ;
		Caption = "\<from:", ;
		Height = 15, ;
		Left = 84, ;
		Top = 237, ;
		Width = 25, ;
		TabIndex = 15, ;
		Name = "Label11"


	ADD OBJECT label12 AS label WITH ;
		AutoSize = .T., ;
		FontName = "MS Sans Serif", ;
		Caption = "\<to:", ;
		Height = 15, ;
		Left = 162, ;
		Top = 237, ;
		Width = 14, ;
		TabIndex = 17, ;
		Name = "Label12"


	ADD OBJECT label2 AS label WITH ;
		FontName = "MS Sans Serif", ;
		Caption = "\<Name:", ;
		Height = 17, ;
		Left = 24, ;
		Top = 28, ;
		Width = 40, ;
		TabIndex = 2, ;
		Name = "Label2"


	ADD OBJECT label1 AS label WITH ;
		FontName = "MS Sans Serif", ;
		Caption = "Printer", ;
		Height = 16, ;
		Left = 20, ;
		Top = 5, ;
		Width = 40, ;
		TabIndex = 1, ;
		Name = "Label1"


	ADD OBJECT label4 AS label WITH ;
		FontName = "MS Sans Serif", ;
		Caption = "Paper", ;
		Height = 15, ;
		Left = 20, ;
		Top = 89, ;
		Width = 40, ;
		TabIndex = 6, ;
		Name = "Label4"


	ADD OBJECT label5 AS label WITH ;
		FontName = "MS Sans Serif", ;
		Caption = "Orientation", ;
		Height = 15, ;
		Left = 248, ;
		Top = 90, ;
		Width = 63, ;
		TabIndex = 11, ;
		Name = "Label5"


	ADD OBJECT label9 AS label WITH ;
		AutoSize = .T., ;
		FontName = "MS Sans Serif", ;
		Caption = "Print range", ;
		Height = 15, ;
		Left = 20, ;
		Top = 186, ;
		Width = 53, ;
		TabIndex = 13, ;
		Name = "Label9"


	ADD OBJECT label10 AS label WITH ;
		AutoSize = .T., ;
		FontName = "MS Sans Serif", ;
		Caption = "Copies", ;
		Height = 15, ;
		Left = 248, ;
		Top = 186, ;
		Width = 34, ;
		TabIndex = 19, ;
		Name = "Label10"


	ADD OBJECT imgportrait AS image WITH ;
		Picture = "portrait.bmp", ;
		BackStyle = 0, ;
		Height = 32, ;
		Left = 259, ;
		Top = 123, ;
		Width = 26, ;
		Name = "imgPortrait"


	ADD OBJECT cboprnname AS combobox WITH ;
		FontName = "MS Sans Serif", ;
		ColumnWidths = "65535", ;
		Height = 20, ;
		Left = 84, ;
		Sorted = .T., ;
		Style = 2, ;
		TabIndex = 3, ;
		Top = 24, ;
		Width = 266, ;
		Name = "cboPrnName"


	ADD OBJECT lblwhere AS label WITH ;
		FontName = "MS Sans Serif", ;
		BorderStyle = 1, ;
		Caption = "Printer Location", ;
		Height = 16, ;
		Left = 84, ;
		Top = 56, ;
		Width = 266, ;
		TabIndex = 5, ;
		Name = "lblWhere"


	ADD OBJECT cbopaper AS combobox WITH ;
		FontName = "MS Sans Serif", ;
		ColumnCount = 1, ;
		Height = 20, ;
		Left = 72, ;
		Style = 2, ;
		TabIndex = 8, ;
		Top = 116, ;
		Width = 144, ;
		Name = "cboPaper"


	ADD OBJECT cbosource AS combobox WITH ;
		FontName = "MS Sans Serif", ;
		ColumnCount = 1, ;
		ColumnWidths = "65535", ;
		Height = 20, ;
		Left = 72, ;
		Style = 2, ;
		TabIndex = 10, ;
		Top = 140, ;
		Width = 144, ;
		Name = "cboSource"


	ADD OBJECT opgorientation AS optiongroup WITH ;
		AutoSize = .T., ;
		ButtonCount = 2, ;
		BorderStyle = 0, ;
		Value = 1, ;
		Height = 58, ;
		Left = 291, ;
		Top = 110, ;
		Width = 90, ;
		TabIndex = 12, ;
		Name = "opgOrientation", ;
		Option1.FontName = "MS Sans Serif", ;
		Option1.Caption = "P\<ortrait", ;
		Option1.Value = 1, ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.Top = 5, ;
		Option1.Width = 61, ;
		Option1.Name = "Portrait", ;
		Option2.FontName = "MS Sans Serif", ;
		Option2.Caption = "L\<andscape", ;
		Option2.Height = 17, ;
		Option2.Left = 5, ;
		Option2.Top = 36, ;
		Option2.Width = 80, ;
		Option2.AutoSize = .F., ;
		Option2.Name = "Landscape"


	ADD OBJECT opgprintrange AS optiongroup WITH ;
		AutoSize = .T., ;
		ButtonCount = 2, ;
		BackStyle = 0, ;
		BorderStyle = 0, ;
		Value = 1, ;
		Height = 54, ;
		Left = 24, ;
		Top = 203, ;
		Width = 71, ;
		TabIndex = 14, ;
		Name = "opgPrintRange", ;
		Option1.FontName = "MS Sans Serif", ;
		Option1.Caption = "\<All", ;
		Option1.Value = 1, ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.Top = 5, ;
		Option1.Width = 61, ;
		Option1.Name = "Option1", ;
		Option2.FontName = "MS Sans Serif", ;
		Option2.Caption = "Pa\<ges", ;
		Option2.Height = 17, ;
		Option2.Left = 5, ;
		Option2.Top = 32, ;
		Option2.Width = 61, ;
		Option2.Name = "Option2"


	ADD OBJECT txtpagefrom AS textbox WITH ;
		FontName = "MS Sans Serif", ;
		Alignment = 3, ;
		Value = 1, ;
		Height = 20, ;
		Left = 111, ;
		SelectOnEntry = .T., ;
		TabIndex = 16, ;
		Top = 233, ;
		Width = 39, ;
		Name = "txtPageFrom"


	ADD OBJECT txtpageto AS textbox WITH ;
		FontName = "MS Sans Serif", ;
		Alignment = 3, ;
		Value = 9999, ;
		Height = 20, ;
		Left = 177, ;
		SelectOnEntry = .T., ;
		TabIndex = 18, ;
		Top = 233, ;
		Width = 39, ;
		Name = "txtPageTo"


	ADD OBJECT spncopies AS spinner WITH ;
		FontName = "MS Sans Serif", ;
		Height = 20, ;
		Left = 354, ;
		SpinnerLowValue =   1.00, ;
		TabIndex = 21, ;
		Top = 218, ;
		Width = 60, ;
		Value = 1, ;
		Name = "spnCopies"


	ADD OBJECT cmdnetwork AS commandbutton WITH ;
		Top = 276, ;
		Left = 12, ;
		Height = 23, ;
		Width = 72, ;
		Caption = "Network...", ;
		TabIndex = 22, ;
		Name = "cmdNetwork"


	ADD OBJECT cmdok AS commandbutton WITH ;
		Top = 276, ;
		Left = 282, ;
		Height = 23, ;
		Width = 72, ;
		Caption = "OK", ;
		Default = .T., ;
		TabIndex = 23, ;
		Name = "cmdOK"


	ADD OBJECT cmdcancel AS commandbutton WITH ;
		Top = 276, ;
		Left = 360, ;
		Height = 23, ;
		Width = 72, ;
		Cancel = .T., ;
		Caption = "Cancel", ;
		TabIndex = 24, ;
		Name = "cmdCancel"


	ADD OBJECT getversionex AS getversionex WITH ;
		Top = 278, ;
		Left = 100, ;
		Name = "Getversionex"


	ADD OBJECT imglandscape AS image WITH ;
		Picture = "landscape.bmp", ;
		BackStyle = 0, ;
		Height = 26, ;
		Left = 256, ;
		Top = 126, ;
		Visible = .F., ;
		Width = 32, ;
		Name = "imgLandscape"


	ADD OBJECT fileprint AS checkbox WITH ;
		Top = 57, ;
		Left = 357, ;
		Height = 17, ;
		Width = 69, ;
		Caption = "To File", ;
		Value = .F., ;
		Name = "FilePrint"


	*-- Set the printer name drop down.
	PROCEDURE setprnname
		LPARAMETERS tlInit
		*!*	tlInit - The first time this is created
		WITH THISFORM

			.prnCount = APRINTERS(.PrnArray)
			= ASORT(.PrnArray)

			nNewPrintCount = .prnCount
			*!*	Remove printers from the available printers list
			FOR Counter = 1 TO .prnCount
				IF EMPTY(.PrnArray[Counter, 1])
					LOOP
				ENDIF
				IF (UPPER(.PrnArray[Counter, 1]) $ UPPER(.prnExclusions))
					ADEL(.PrnArray, Counter)
					Counter = Counter - 1
					nNewPrintCount = nNewPrintCount - 1
				ENDIF
			ENDFOR
			.prnCount = nNewPrintCount

			*!*	If there are no printers left, don't enable any of the components.
			IF .prnCount = 0
				DIMENSION .PrnArray[1, 2]
				.PrnArray = "No Printers Available"
				.cboPrnName.ADDITEM(.PrnArray[1, 1], 1)
				.cboPrnName.LISTINDEX = 1
				.cboPrnName.ENABLED = .F.

			ELSE
				DIMENSION .PrnArray[.prnCount, 2]
				.cboPrnName.ENABLED = .T.
				.cboPrnName.CLEAR
				FOR Counter = 1 TO .prnCount
					IF LEFT(.PrnArray[Counter, 1], 1) = "\"
						*!*	A single "\" will make a list item disabled,
						*!*	use a double "\" to enable it.
						.cboPrnName.ADDITEM("\" + .PrnArray[Counter, 1], Counter)
					ELSE
						.cboPrnName.ADDITEM(.PrnArray[Counter, 1], Counter)
					ENDIF
					*!*	Set the default printer to the VFP default printer.
					IF tlInit
						IF UPPER(.PrnArray[Counter, 1]) = UPPER(SET("PRINTER", 2))
							.cboPrnName.LISTINDEX = Counter
							.lblWhere.CAPTION = .PrnArray[Counter, 2]
							tlInit = .F.  && No need to check this again.
						ENDIF
					ENDIF
				ENDFOR
			ENDIF
		ENDWITH
	ENDPROC


	*-- Set the paper sizes dropdown.
	PROCEDURE setprnsize
		LOCAL cPaperNumbers, cPaperNames, nPaperTypes, Counter
		LOCAL cPrnName, cPrnPort

		WITH THISFORM
			IF .prnCount = 0
				.cboPaper.ENABLED = .F.
				RETURN
			ENDIF
			.cboPaper.ENABLED = .T.

			cPrnName = .PrnArray[.cboPrnName.LISTINDEX, 1]
			cPrnPort = .PrnArray[.cboPrnName.LISTINDEX, 2]

			*------ get then allocate string sizes required for Paper information ------
			nPaperTypes = DeviceCapabilities(cPrnName, cPrnPort, DC_PAPERS, 0, 0)
			cPaperNumbers = SPACE((nPaperTypes*2))
			cPaperNames = SPACE((nPaperTypes*64))

			*------ retrieve and proccess Paper information ------
			= DeviceCapabilities(cPrnName, cPrnPort, DC_PAPERS, @cPaperNumbers, 0)
			= DeviceCapabilities(cPrnName, cPrnPort, DC_PAPERNAMES, @cPaperNames, 0)

			DIMENSION .prnPaper[nPaperTypes, 2]
			.cboPaper.CLEAR

			FOR Counter = 1 TO nPaperTypes
				.prnPaper[Counter, 2] = (ASC(SUBSTR(cPaperNumbers, (Counter*2), 1))*256) + ;
					(ASC(SUBSTR(cPaperNumbers, (Counter*2) - 1, 1)))
				.prnPaper[Counter, 1] = SUBSTR(cPaperNames, ((Counter - 1)*64) + 1, 64)
				IF LEFT(.prnPaper[Counter, 1], 1) = "\"
					.cboPaper.ADDITEM("\" + .prnPaper[Counter, 1], Counter)
				ELSE
					.cboPaper.ADDITEM(.prnPaper[Counter, 1], Counter)
				ENDIF
				IF (PRTINFO(2, cPrnName) = .prnPaper[Counter, 2])
					.cboPaper.LISTINDEX = Counter
				ENDIF
			ENDFOR
		ENDWITH
	ENDPROC


	*-- Set the printer paper source dropdown.
	PROCEDURE setprnsource
		LOCAL cBinNumbers, cBinNames, nBinCount, Counter
		LOCAL cPrnName, cPrnPort

		WITH THISFORM
			IF .prnCount = 0
				.cboSource.ENABLED = .F.
				RETURN
			ENDIF
			.cboSource.ENABLED = .T.

			cPrnName = .PrnArray[.cboPrnName.LISTINDEX, 1]
			cPrnPort = .PrnArray[.cboPrnName.LISTINDEX, 2]

			*------ get then allocate string sizes required for bin information ------
			nBinCount = DeviceCapabilities(cPrnName, cPrnPort, DC_BINS, 0, 0)
			cBinNumbers = SPACE((nBinCount*2))
			cBinNames = SPACE((nBinCount*24))

			*------ retrieve and proccess bin information ------
			= DeviceCapabilities(cPrnName, cPrnPort, DC_BINS, @cBinNumbers, 0)
			= DeviceCapabilities(cPrnName, cPrnPort, DC_BINNAMES, @cBinNames, 0)

			DIMENSION .PrnBins[nBinCount, 2]
			.cboSource.CLEAR

			FOR Counter = 1 TO nBinCount
				.PrnBins[Counter, 2] = (ASC(SUBSTR(cBinNumbers, (Counter*2), 1))*256) + ;
					(ASC(SUBSTR(cBinNumbers, (Counter*2) - 1, 1)))
				.PrnBins[Counter, 1] = SUBSTR(cBinNames, ((Counter - 1)*24) + 1 , 24)
				IF LEFT(.PrnBins[Counter, 1], 1) = "\"
					.cboSource.ADDITEM("\" + .PrnBins[Counter, 1], Counter)
				ELSE
					.cboSource.ADDITEM(.PrnBins[Counter, 1], Counter)
				ENDIF
				IF (PRTINFO(7, cPrnName) = .PrnBins[Counter, 2])
					.cboSource.LISTINDEX = Counter
				ENDIF
			ENDFOR
		ENDWITH
	ENDPROC


	*-- Set the printer copies spinner.
	PROCEDURE setprncopies
		LPARAMETERS tlInit
		LOCAL cCopies, MaxCopies
		LOCAL cPrnName, cPrnPort

		WITH THISFORM
		   IF .prnCount = 0
		      .spnCopies.ENABLED = .F.
		      RETURN
		   ENDIF
		   .spnCopies.ENABLED = .T.

		   cPrnName = .PrnArray[.cboPrnName.LISTINDEX, 1]
		   cPrnPort = .PrnArray[.cboPrnName.LISTINDEX, 2]

		   *------ retrieve and proccess number of copies supported ------
		   cCopies = ""
		   MaxCopies = DeviceCapabilities(cPrnName, cPrnPort, DC_COPIES, @cCopies, 0)
		   IF (MaxCopies < 1)
		      MaxCopies = 1
		   ENDIF

		   .spnCopies.SPINNERHIGHVALUE = MIN(MaxCopies, 9999)
		   .spnCopies.ENABLED = ( MaxCopies > 1 )
		   .spnCopies.VALUE = PRTINFO(6, cPrnName)
		ENDWITH
	ENDPROC


	*-- Set the printer orientation option group.
	PROCEDURE setprnorientation
		LPARAMETERS tlInit
		LOCAL cPrnName, cPrnPort

		WITH THISFORM
		   IF .prnCount = 0
		      .opgOrientation.ENABLED = .F.
		      RETURN
		   ENDIF
		   .opgOrientation.ENABLED = .T.

		   cPrnName = .PrnArray[.cboPrnName.LISTINDEX, 1]
		   cPrnPort = .PrnArray[.cboPrnName.LISTINDEX, 2]

		   *!*	Orientation is Portrait (0) or Landscape (1)
		   .opgOrientation.VALUE = PRTINFO(1, cPrnName) + 1
		ENDWITH
	ENDPROC


	*-- Set the report properties in the EXPR field.
	PROCEDURE setproperties
		#DEFINE VF_CRLF CHR(13) + CHR(10)

		LOCAL TmpExpr, lcShortName

		*!*	Set all properties of the report
		WITH THISFORM
			.printername        = .cboPrnName.VALUE
			.printerPapersize   = .prnPaper[.cboPaper.LISTINDEX, 2]
			.printerPapersource = .PrnBins[.cboSource.LISTINDEX, 2]
			.printerOrientation = .opgOrientation.VALUE - 1
			.printercopies      = .spnCopies.VALUE

			TmpExpr = ;
				"ORIENTATION=" + ALLTRIM(STR(.printerOrientation)) + VF_CRLF + ;
				"PAPERSIZE=" + ALLTRIM(STR(.printerPapersize)) + VF_CRLF + ;
				"COPIES=" + ALLTRIM(STR(.printercopies)) + VF_CRLF + ;
				"DEFAULTSOURCE=" + ALLTRIM(STR(.printerPapersource)) + VF_CRLF

			UPDATE (.RptTmpFile + "." + .RptExt) SET ;
				EXPR = TmpExpr, ;
				TAG = "", ;
				TAG2 = "" ;
				WHERE objType = 1 AND objCode = 53

			lcShortName = JUSTFNAME(.RptTmpFile)
			USE IN (lcShortName)

		ENDWITH
	ENDPROC


	*-- Print the label or report.
	PROCEDURE printreport
		LOCAL lcOldPrinter, lnPrintRangeFrom, lnPrintRangeTo, lcWhere_For, lcScope, lcFileName

		WITH THISFORM

		   IF thisform.FilePrint.Value
		      lcFileName = PUTFILE("Choose File Name",JUSTSTEM(.RptTmpFile),"PRN")
		      IF EMPTY(lcFileName)
		         RETURN
		      ENDIF
		      lcFileName = FORCEEXT(lcFileName,"PRN")     
		   ENDIF 
		   *!*	Set the user defined scope and WHERE/FOR clauses
		   lcForWhile = .cForWhile
		   lcScope = .cScope
		   *!*	 Prepare the print range.  If all pages (opgPrintRange = 1),
		   *!*	 then use 1,9999 otherwise use the form properties
		   lnPrintRangeFrom = IIF(.opgPrintRange.VALUE = 1, 1, .txtPageFrom.VALUE)
		   lnPrintRangeTo = IIF(.opgPrintRange.VALUE = 1, 9999, .txtPageTo.VALUE)

		   *!*	Remember the current FoxPro printer setting
		   lcOldPrinter = SET('PRINTER', 3)
		   SET PRINTER TO NAME(.printername)
		   *!*	Run either the LABEL FORM or the REPORT FORM
		   DO CASE
		   CASE .RptExt = "FRX"
		        IF thisform.FilePrint.Value
		           REPORT FORM (.RptTmpFile) TO FILE (lcFileName);
		                       &lcForWhile ;
		                       &lcScope ;
		                       NOCONSOLE ;
		                       RANGE lnPrintRangeFrom,lnPrintRangeTo
		        ELSE
		           REPORT FORM (.RptTmpFile) TO PRINTER ;
		                       &lcForWhile ;
		                       &lcScope ;
		                       NOCONSOLE ;
		                       RANGE lnPrintRangeFrom,lnPrintRangeTo
		        ENDIF
		   CASE .RptExt = "LBX"
		        IF thisform.FilePrint.Value
		           LABEL FORM (.RptTmpFile) TO FILE (lcFileName);
		                 &lcForWhile ;
		                 &lcScope ;
		                 NOCONSOLE ;
		                 RANGE lnPrintRangeFrom,lnPrintRangeTo

		        ELSE
		           LABEL FORM (.RptTmpFile) TO PRINTER ;
		                 &lcForWhile ;
		                 &lcScope ;
		                 NOCONSOLE ;
		                 RANGE lnPrintRangeFrom,lnPrintRangeTo
		        ENDIF
		   OTHERWISE
		      =MESSAGEBOX("Cannot print report")
		   ENDCASE
		   SET PRINTER TO NAME(lcOldPrinter)
		ENDWITH
	ENDPROC


	*-- Default an empty extension to FRX.
	PROCEDURE rptext_assign
		LPARAMETERS vNewVal
		*To do: Modify this routine for the Assign method
		*!*	Default RptExt to "FRX"
		IF EMPTY(vNewVal)
			m.vNewVal = 'FRX'
		ENDIF
		THIS.RptExt = m.vNewVal
	ENDPROC


	PROCEDURE Load
		*!*	Used to determine paper size/name, source bin/name, and copies supported
		DECLARE LONG DeviceCapabilities IN "winspool.drv" ;
			STRING  lpDeviceName, ;
			STRING  lpPort, ;
			LONG    iIndex, ;
			STRING@ lpOutput, ;
			INTEGER lpDevMode
	ENDPROC


	PROCEDURE Init
		*!*	This form replaces the REPORT/LABEL FORM ... TO PRINTER PROMPT ...
		*!*	This form allows hiding printers from the user so unsupported printes are
		*!*	not displayed.  Only NT/Win2000 machines will have the Network button displayed.
		*!*	PARAMETERS:
		*!*		tcReportName - If empty, user will be prompted.  If the extention
		*!*		               is not supplied, it will default to FRX.
		*!*		tcForWhile   - Add any "FOR <expr>" and/or "WHILE <expr>" desired
		*!*		tcScope      - Default to ALL

		LPARAMETERS tcReportName, tcForWhile, tcScope
		LOCAL inPrnName, inCopies, inOrientation, inPapersize, inPapersource
		LOCAL nWA, lcShortName
		LOCAL Counter, cDefaultPrinter

		IF EMPTY(tcReportName)
			tcReportName = GETFILE('frx;lbx')
			IF EMPTY(tcReportName)
				*!*	If no report is selected, close the print setup
				RETURN .F.
			ENDIF
		ENDIF
		tcReportName = UPPER(tcReportName)

		WITH THISFORM
			IF NOT EMPTY(tcScope)
				.cScope = tcScope
			ENDIF
			IF NOT EMPTY(tcForWhile)
				.cForWhile = tcForWhile
			ENDIF

			.RptExt = JUSTEXT(tcReportName)
			.RptPath = ADDBS(JUSTPATH(tcReportName))
			tcReportName = ADDBS(JUSTPATH(tcReportName)) + JUSTSTEM(tcReportName)

			nWA = SELECT()

			*!*	Set up the temporary report file in the TEMP folder.
			lcShortName = JUSTFNAME(tcReportName)
			.RptTmpFile = ADDBS(SYS(2023)) + LEFT(SYS(2015), 8)
			*!*	Make sure we do not overwrite another temp file
			DO WHILE FILE(.RptTmpFile + "." + .RptExt)
				.RptTmpFile = ADDBS(SYS(2023)) + SYS(3)
			ENDDO

			*!*	Open the report table and copy to temp file for manipulation
			SELECT * FROM (tcReportName + "." + .RptExt) INTO TABLE (.RptTmpFile + "." + .RptExt)
			USE IN (lcShortName)


			*------ set up current report settings -------
			LOCATE FOR objType = 1 AND objCode = 53  && This is the main record, usually the first record.
			inPrnName     = ""
			inCopies      = -1
			inOrientation = -1
			inPapersize   = -1
			inPapersource = -1

			ArrayCount = ALINES(aMemLine, EXPR, .T.)
			FOR Counter = 1 TO ArrayCount
				IF ("DEVICE" $ UPPER(aMemLine[Counter]))
					inPrnName = SUBSTR(aMemLine[Counter], AT("=", aMemLine[Counter]) + 1)
				ENDIF
				IF ("ORIENTATION" $ UPPER(aMemLine[Counter]))
					inOrientation = INT(VAL(SUBSTR(aMemLine[Counter], AT("=", aMemLine[Counter]) + 1)))
				ENDIF
				IF ("PAPERSIZE" $ UPPER(aMemLine[Counter]))
					inPapersize = INT(VAL(SUBSTR(aMemLine[Counter], AT("=", aMemLine[Counter]) + 1)))
				ENDIF
				IF ("COPIES" $ UPPER(aMemLine[Counter]))
					inCopies = INT(VAL(SUBSTR(aMemLine[Counter], AT("=", aMemLine[Counter]) + 1)))
				ENDIF
				IF ("DEFAULTSOURCE" $ UPPER(aMemLine[Counter]))
					inPapersource = INT(VAL(SUBSTR(aMemLine[Counter], AT("=", aMemLine[Counter]) + 1)))
				ENDIF
			ENDFOR
			USE

			*!*	Return to the previous workarea for reporting.
			SELECT (nWA)

			*------ Set the Printer Name list
			.SetPrnName(.T.)
			IF .cboPrnName.LISTINDEX = 0
				.cboPrnName.LISTINDEX = 1
			ENDIF

			*------ if possible select report printer --------
			IF (LEN(inPrnName) > 0)
				FOR Counter = 1 TO .prnCount
					IF UPPER(.PrnArray[Counter, 1]) = UPPER(inPrnName)
						.cboPrnName.LISTINDEX = Counter
						.lblWhere.CAPTION = .PrnArray[Counter, 2]
					ENDIF
				ENDFOR
			ELSE
				cDefaultPrinter = SET('PRINTER', 3)
				FOR Counter = 1 TO .prnCount
					IF UPPER(.PrnArray[Counter, 1]) = UPPER(cDefaultPrinter)
						.cboPrnName.LISTINDEX = Counter
						.lblWhere.CAPTION = .PrnArray[Counter, 2]
					ENDIF
				ENDFOR
			ENDIF

			*------ Build the Size list
			.SetPrnSize()
			*------ if possible select report Paper size ------
			IF (inPapersize > -1)
				FOR Counter = 1 TO .cboPaper.LISTCOUNT
					IF (inPapersize = .prnPaper[Counter, 2])
						.cboPaper.LISTINDEX = Counter
					ENDIF
				ENDFOR
			ENDIF

			*------ Build the Source list
			.SetPrnSource()
			*------ if possible select incomming Paper bin ------
			IF (inPapersource > -1)
				FOR Counter = 1 TO .cboSource.LISTCOUNT
					IF (inPapersource = .PrnBins[Counter, 2])
						.cboSource.LISTINDEX = Counter
					ENDIF
				ENDFOR
			ENDIF
			*------ if the paper source of the report is not a member of ------
			*------ the printer papers source, assign the first printer source ------
			IF .cboSource.LISTINDEX = 0
				.cboSource.LISTINDEX = 1
			ENDIF

			*------ retrieve and proccess number of copies supported ------
			.SetPrnCopies()
			*------ if possible select incomming copies ------
			IF ((inCopies > -1) AND (.spnCopies.ENABLED = .T.))
				.spnCopies.VALUE = inCopies
			ELSE
				.spnCopies.VALUE = 1
			ENDIF

			*------ retrieve and proccess orientation information ------
			.SetPrnOrientation()

			*------ if possible select incomming orientation ------
			IF (inOrientation > -1)
				IF (inOrientation = 0)
					.opgOrientation.Portrait.VALUE  = 1
					.opgOrientation.Landscape.VALUE = 0
					.imgPortrait.VISIBLE = .T.
					.imgLandscape.VISIBLE = .F.
				ELSE
					.opgOrientation.Portrait.VALUE  = 0
					.opgOrientation.Landscape.VALUE = 1
					.imgPortrait.VISIBLE = .F.
					.imgLandscape.VISIBLE = .T.
				ENDIF
			ENDIF

			.opgPrintRange.ENABLED = ( .prnCount > 0 )
			.txtPageFrom.ENABLED = ( .prnCount > 0 )
			.txtPageTo.ENABLED = ( .prnCount > 0 )
			.cmdOK.ENABLED = ( .prnCount > 0 )

		ENDWITH

		*!*	If this is not an NT platform OS, do not allow the Network button
		WITH THISFORM.GetVersionEx
			IF .lValid
				IF NOT ("NT" $ .cPlatform )
					THISFORM.REMOVEOBJECT("cmdNetwork")
				ENDIF
			ENDIF
		ENDWITH
	ENDPROC


	PROCEDURE Destroy
		*!*	Erase the temp report files
		WITH THISFORM
			IF USED(JUSTFNAME(.RptTmpFile))
				USE IN (JUSTFNAME(.RptTmpFile))
			ENDIF

			IF FILE(.RptTmpFile + "." + .RptExt)
				ERASE (.RptTmpFile + "." + .RptExt)
			ENDIF
			IF FILE(.RptTmpFile + ".frt")
				ERASE (.RptTmpFile + ".frt")
			ENDIF
		ENDWITH
	ENDPROC


	PROCEDURE cboprnname.InteractiveChange
		LOCAL PrevPaperSize, PrevPaperBin, PrevCopies, lSet
		*------ Make sure that the Source index is set to a valid value
		*------ even if there is no source available
		lSet = .F.

		WITH THISFORM
			.LOCKSCREEN = .T.
			*------ update where information on form ------
			.lblWhere.CAPTION = .PrnArray[.cboPrnName.LISTINDEX,2]
			*------ get then allocate string sizes required for paper information ------
			PrevPaperSize = IIF(.cboPaper.LISTINDEX = 0, 0, .prnPaper[.cboPaper.LISTINDEX, 2])
			*------ Build the Size list
			.SetPrnSize()
			*------ if possible select previous Paper size selection ------
			lSet = .F.
			FOR Counter = 1 TO .cboPaper.LISTCOUNT
				IF (.prnPaper[Counter, 2] = PrevPaperSize)
					.cboPaper.LISTINDEX = Counter
					lSet = .T.
					EXIT
				ENDIF
			ENDFOR
			*------ If no paper size is preselected or available, set index to 1
			IF PrevPaperSize = 0 OR lSet = .F.
				.cboPaper.LISTINDEX = 1
			ENDIF

			*------ Build the Source list
			PrevPaperBin = IIF(.cboSource.LISTINDEX = 0, 0, .PrnBins[.cboSource.LISTINDEX, 2])
			.SetPrnSource()
			*------ if possible select previous Paper bin selection ------
			lSet = .F.
			FOR Counter = 1 TO .cboSource.LISTCOUNT
				IF (.PrnBins[Counter, 2] = PrevPaperBin)
					.cboSource.LISTINDEX = Counter
					lSet = .T.
					EXIT
				ENDIF
			ENDFOR
			*------ If no paper bin is preselected or available, set index to 1
			IF PrevPaperBin = 0 OR lSet = .F.
				.cboSource.LISTINDEX = 1
			ENDIF

			*------ Set number of copies supported ------
			PrevCopies = .spnCopies.VALUE
			.SetPrnCopies()
			*------ if possible select previous number of copies ------
			.spnCopies.VALUE = IIF(PrevCopies <= .spnCopies.SPINNERHIGHVALUE, PrevCopies, .spnCopies.SPINNERHIGHVALUE)

			*------ do not proccess orientation, this will allow prev setting to cary over ------

			.LOCKSCREEN = .F.
		ENDWITH
	ENDPROC


	PROCEDURE lblwhere.Init
		*!*	Make this lable "invisible" at runtime
		THIS.BORDERSTYLE = 0
		THIS.CAPTION = ''
	ENDPROC


	PROCEDURE opgorientation.Portrait.Click
		WITH THISFORM
			.LOCKSCREEN = .T.
			.imgPortrait.VISIBLE = .T.
			.imgLandscape.VISIBLE = .F.
			.LOCKSCREEN = .F.
		ENDWITH
	ENDPROC


	PROCEDURE opgorientation.Landscape.Click
		WITH THISFORM
			.LOCKSCREEN = .T.
			.imgPortrait.VISIBLE = .F.
			.imgLandscape.VISIBLE = .T.
			.LOCKSCREEN = .F.
		ENDWITH
	ENDPROC


	PROCEDURE opgprintrange.Option2.Click
		THISFORM.txtPageFrom.SETFOCUS()
	ENDPROC


	PROCEDURE txtpagefrom.InteractiveChange
		THISFORM.opgPrintRange.VALUE = 2
	ENDPROC


	PROCEDURE txtpageto.InteractiveChange
		THISFORM.opgPrintRange.VALUE = 2
	ENDPROC


	PROCEDURE cmdnetwork.Click
		DECLARE ConnectToPrinterDlg IN "winspool.drv" ;
			LONG HWND, ;
			LONG flags

		DECLARE INTEGER GetFocus IN "user32" AS "GetFocus"

		HWND = GetFocus()
		IF HWND = 0
			=MESSAGEBOX("Unable to get window handle.")
			RETURN
		ENDIF

		IF ConnectToPrinterDlg(HWND, 0)
			WITH THISFORM
				.SetPrnName()
				IF .prnCount = 1
					*!*	A new printer was added and this is the only one
					.cboPrnName.LISTINDEX = 1
					.setPrnSize()
					.cboPaper.LISTINDEX = 1
					.setprnsource()
					.cboSource.LISTINDEX = 1
					.SetPrnCopies()
					.SetPrnOrientation()
					.opgPrintRange.ENABLED = .T.
					.txtPageFrom.ENABLED = .T.
					.txtPageTo.ENABLED = .T.
					.cmdOK.ENABLED = .T.
				ENDIF
			ENDWITH
		ENDIF
	ENDPROC


	PROCEDURE cmdok.Click
		THISFORM.SetProperties()
		THISFORM.PrintReport()
		THISFORM.cmdCancel.CLICK()
	ENDPROC


	PROCEDURE cmdcancel.Click
		THISFORM.RELEASE()
	ENDPROC


ENDDEFINE
*
*-- EndDefine: reportformprompt
**************************************************
Use it that way:

DO FORM ReportPrompt WITH full_Path_to_report.

Check if this works for you.
Against Stupidity the Gods themselves Contend in Vain - Johann Christoph Friedrich von Schiller
The only thing normal about database guys is their tables.
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform