自定义报表打印设置对话框
出处:网络
说明：原有的VFP的打印设置框，应该说她没什么不好，只是有时她是系统提供的，我们很难对她进行一些人为的设置，所以也只能使用她的提供的功能，而她没提供的功能就很难去实现，或者不方便，因此针对此情况编写此程序用来替换系统的打印设置对话框，采用自定义的打印设置对话框。
提示：因为该文处于文章排版的需要，所以采用了汉字双字节的空格，而这些空格在程序中执行会提示错误，所以请将以下代码选择复制后，请再处理去掉其中包含的双字节空格，可用一些文字处理软件将双字节空格“ ”全部替换为单字节空格！
*-- 程序名称：RptPrint.prg
*-- 程序功能：以自定义的对话框显示报表的打印设置，以取代系统打印设置的一些不足
*-- 使用方法：RptPrint ( [] )
* 或者：do RptPrint [ with ]
*-- 程序说明：cReportName 为 报表文件名（无须带扩展名），如果省略的话，则可显示设置对话框
* 报表的扩展名以 frx 为准
*-- 原创作者：红虎
*-- 联系方式：E-mail: hu_feng@163.net
* HomePage: http://www.honghoo.net
* Oicq: 1569040
*-- 编写日期：2001年1月
Func RptPrint
para rptname
*-- 创建打印设置对话框
oPrintSetup=createobject("printsetup")
oPrintSetup.show
*-- 定义打印设置对话框
DEFINE CLASS printsetup AS form
Top = 11
Left = 115
Height = 270
Width = 531
Desktop = .T.
DoCreate = .T.
Caption = "报表打印设置"
Name = "PRINTSETUP"
*-- 新增属性
nxcoord = 0 && 可以使点击对话框就可以拖动的坐标
nycoord = 0
rptname = "" && 报表的文件名
ADD OBJECT shape1 AS shape WITH ;
Top = 12, ;
Left = 12, ;
Height = 144, ;
Width = 504, ;
Enabled = .F., ;
SpecialEffect = 0, ;
Name = "Shape1"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
Caption = "打印机", ;
Height = 16, ;
Left = 22, ;
Top = 9, ;
Width = 38, ;
Name = "Label1"
*-- 存放目前安装的打印机的名称列表
ADD OBJECT printerlist AS combobox WITH ;
Alignment = 0, ;
Height = 22, ;
Left = 112, ;
Style = 2, ;
Top = 33, ;
Width = 260, ;
Name = "PrinterList"
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
Caption = "打印机名(\<N)：", ;
Height = 16, ;
Left = 24, ;
Top = 36, ;
Width = 86, ;
Name = "Label2"
ADD OBJECT label3 AS label WITH ;
AutoSize = .T., ;
Caption = "状态：", ;
Height = 16, ;
Left = 24, ;
Top = 60, ;
Width = 38, ;
Name = "Label3"
ADD OBJECT label4 AS label WITH ;
AutoSize = .T., ;
Caption = "类型：", ;
Height = 16, ;
Left = 24, ;
Top = 84, ;
Width = 38, ;
Name = "Label4"
ADD OBJECT label5 AS label WITH ;
AutoSize = .T., ;
Caption = "位置：", ;
Height = 16, ;
Left = 24, ;
Top = 108, ;
Width = 38, ;
Name = "Label5"
ADD OBJECT label6 AS label WITH ;
AutoSize = .T., ;
Caption = "纸张：", ;
Height = 16, ;
Left = 24, ;
Top = 132, ;
Width = 38, ;
Name = "Label6"
*-- 显示打印机的位置的标签
ADD OBJECT printerlocation AS label WITH ;
AutoSize = .T., ;
Caption = "PrinterLocation", ;
Height = 16, ;
Left = 112, ;
Top = 108, ;
Width = 92, ;
Name = "PrinterLocation"
ADD OBJECT cmdok AS commandbutton WITH ;
Top = 178, ;
Left = 442, ;
Height = 25, ;
Width = 66, ;
Caption = "确定", ;
Default = .T., ;
Name = "cmdOk"
*-- 打印机状态标签
ADD OBJECT printerstatus AS label WITH ;
AutoSize = .T., ;
Caption = "PrinterStatus", ;
Height = 16, ;
Left = 112, ;
Top = 60, ;
Width = 80, ;
Name = "PrinterStatus"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 226, ;
Left = 442, ;
Height = 25, ;
Width = 66, ;
Cancel = .T., ;
Caption = "取消", ;
Name = "Command1"
ADD OBJECT shape5 AS shape WITH ;
Top = 171, ;
Left = 14, ;
Height = 84, ;
Width = 252, ;
Enabled = .F., ;
SpecialEffect = 0, ;
Name = "Shape5"
ADD OBJECT label11 AS label WITH ;
AutoSize = .T., ;
Caption = "打印范围", ;
Height = 16, ;
Left = 24, ;
Top = 168, ;
Width = 50, ;
Name = "Label11"
ADD OBJECT shape6 AS shape WITH ;
Top = 170, ;
Left = 276, ;
Height = 84, ;
Width = 143, ;
Enabled = .F., ;
SpecialEffect = 0, ;
Name = "Shape6"
ADD OBJECT label12 AS label WITH ;
AutoSize = .T., ;
Caption = "份数", ;
Height = 16, ;
Left = 286, ;
Top = 167, ;
Width = 26, ;
Name = "Label12"
*-- 打印范围选择
ADD OBJECT optiongroup2 AS optiongroup WITH ;
AutoSize = .F., ;
ButtonCount = 3, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Value = 1, ;
Enabled = .T., ;
Height = 62, ;
Left = 25, ;
Top = 184, ;
Width = 236, ;
Name = "Optiongroup2", ;
Option1.Caption = "全部(\<A)", ;
Option1.Value = 1, ;
Option1.Height = 16, ;
Option1.Left = 5, ;
Option1.Style = 0, ;
Option1.Top = 5, ;
Option1.Width = 69, ;
Option1.AutoSize = .T., ;
Option1.Name = "Option1", ;
Option2.Caption = "当前页(\<E)", ;
Option2.Height = 16, ;
Option2.Left = 82, ;
Option2.Style = 0, ;
Option2.Top = 5, ;
Option2.Width = 81, ;
Option2.AutoSize = .T., ;
Option2.Name = "Option2", ;
Option3.Caption = "页码(\<G)", ;
Option3.Height = 16, ;
Option3.Left = 5, ;
Option3.Style = 0, ;
Option3.Top = 34, ;
Option3.Width = 69, ;
Option3.AutoSize = .T., ;
Option3.Name = "Option3"
*-- 打印起始页
ADD OBJECT pbpage AS textbox WITH ;
Alignment = 3, ;
Value = 1, ;
Enabled = .F., ;
Height = 20, ;
InputMask = "9999", ;
Left = 120, ;
SelectOnEntry = .T., ;
Top = 219, ;
Width = 49, ;
Name = "pbpage"
*-- 打印分数
ADD OBJECT copy AS spinner WITH ;
Height = 20, ;
KeyboardLowValue = 1, ;
Left = 338, ;
SpinnerLowValue = 1.00, ;
Top = 192, ;
Width = 72, ;
Value = 1, ;
Name = "copy"
*-- 是否逐份打印,还是逐页
ADD OBJECT check1 AS checkbox WITH ;
Top = 229, ;
Left = 338, ;
Height = 16, ;
Width = 69, ;
AutoSize = .T., ;
Caption = "逐份打印", ;
Value = .T., ;
Name = "Check1"
ADD OBJECT label14 AS label WITH ;
AutoSize = .T., ;
Caption = "份数(\<C)", ;
Height = 16, ;
Left = 288, ;
Top = 194, ;
Width = 50, ;
Name = "Label14"
*-- 结束页数
ADD OBJECT pepage AS textbox WITH ;
Alignment = 3, ;
Value = _pepage, ;
Enabled = .F., ;
Height = 20, ;
InputMask = "9999", ;
Left = 196, ;
SelectOnEntry = .T., ;
Top = 219, ;
Width = 49, ;
Name = "pepage"
ADD OBJECT label15 AS label WITH ;
AutoSize = .T., ;
Caption = "从", ;
Height = 16, ;
Left = 104, ;
Top = 221, ;
Width = 14, ;
Name = "Label15"
ADD OBJECT label16 AS label WITH ;
AutoSize = .T., ;
Caption = "到", ;
Height = 16, ;
Left = 178, ;
Top = 221, ;
Width = 14, ;
Name = "Label16"
ADD OBJECT command2 AS commandbutton WITH ;
Top = 33, ;
Left = 388, ;
Height = 25, ;
Width = 109, ;
Caption = "打印机设置(\<S)...", ;
Name = "Command2"
*-- 纸张类型及方向
ADD OBJECT papertype AS label WITH ;
AutoSize = .T., ;
Caption = "PaperType", ;
Height = 16, ;
Left = 112, ;
Top = 132, ;
Width = 56, ;
Name = "PaperType"
*-- 当前页号
ADD OBJECT pageno AS textbox WITH ;
Alignment = 3, ;
Value = 9999, ;
Enabled = .F., ;
Height = 20, ;
InputMask = "9999", ;
Left = 196, ;
SelectOnEntry = .T., ;
Top = 190, ;
Width = 49, ;
Name = "pageno"
PROCEDURE getprinterinfo
*-- 获取打印机信息
* 并存放到数组 paPrinter 中
* pnPrinterNo 用来存放打印机的个数
thisform.PrinterLocation.caption = paPrinter(pnPrinterNo,2)
*-- 打印机状态
thisform.PrinterStatus.caption = sys(13)
ENDPROC
PROCEDURE getpaper
*-- 通过 RPTINFO() 函数来获得打印机的纸张设置类型及方向
dime paper_list(41)
paper_list(1) = "Letter, 8 1/2 x 11 in"
paper_list(2) = "Letter Small, 8 1/2 x 11 in"
paper_list(3) = "Tabloid, 11 x 17 in"
paper_list(4) = "Ledger, 17 x 11 in"
paper_list(5) = "Legal, 8 1/2 x 14 in"
paper_list(6) = "Statement, 5 1/2 x 8 1/2 in"
paper_list(7) = "Executive, 7 1/4 x 10 1/2 in"
paper_list(8) = "A3, 297 x 420 mm"
paper_list(9) = "A4, 210 x 297 mm"
paper_list(10) = "A4, Small 210 x 297 mm"
paper_list(11) = "A5, 148 x 210 mm"
paper_list(12) = "B4, 250 x 354 mm"
paper_list(13) = "B5, 182 x 257 mm"
paper_list(14) = "Folio, 8 1/2 x 13 in"
paper_list(15) = "Quarto, 215 x 275 mm"
paper_list(16) = "10 x 14 in"
paper_list(17) = "11 x 17 in"
paper_list(18) = "Note, 8 1/2 x 11 in"
paper_list(19) = "Envelope #9, 3 7/8 x 8 7/8 in"
paper_list(20) = "Envelope #10, 4 1/8 x 9 1/2 in"
paper_list(21) = "Envelope #11, 4 1/2 x 10 3/8 in"
paper_list(22) = "Envelope #12, 4 1/2 x 11 in"
paper_list(23) = "Envelope #14, 5 x 11 1/2 in"
paper_list(24) = "C size sheet"
paper_list(25) = "D size sheet"
paper_list(26) = "E size sheet"
paper_list(27) = "Envelope DL, 110 x 220 mm"
paper_list(28) = "Envelope C5, 162 x 229 mm"
paper_list(29) = "Envelope C3, 324 x 458 mm"
paper_list(30) = "Envelope C4, 229 x 324 mm"
paper_list(31) = "Envelope C6, 114 x 162 mm"
paper_list(32) = "Envelope C65, 114 x 229 mm"
paper_list(33) = "Envelope B4, 250 x 353 mm"
paper_list(34) = "Envelope B5, 176 x 250 mm"
paper_list(35) = "Envelope B6, 176 x 125 mm"
paper_list(36) = "Envelope, 110 x 230 mm"
paper_list(37) = "Envelope Monarch, 3 7/8 x 7.5 in"
paper_list(38) = "6 3/4 Envelope, 3 5/8 x 6 1/2 in"
paper_list(39) = "US Std Fanfold, 14 7/8 x 11 in"
paper_list(40) = "German Std Fanfold, 8 1/2 x 12 in"
paper_list(41) = "German Legal Fanfold, 8 1/2 x 13 in "
RETU PAPER_LIST(prtinfo(2)) + "，" + iif(prtinfo(1)=0,"纵向","横向")
ENDPROC
PROCEDURE MouseMove
*-- 用鼠标拖动表单的移动
Lparameters nButton, nShift, nxcoord, nycoord
With Thisform
if mdown() and nButton = 1
.top = (nycoord - this.nycoord) + .top + 1
.left = (nxcoord - this.nxcoord) + .left + 1
endif
Endwith
ENDPROC
PROCEDURE MouseDown
*-- 当鼠标在表单上按下时，记下表单的坐标位置
Lparameters nButton, nShift, nxcoord, nycoord
This.nxcoord = nxcoord
This.nycoord = nycoord
ENDPROC
PROCEDURE Init
*-- 表单初始化 ...
With thisform
.rptname = rptname
.MinButton = .F.
.MaxButton = .F.
.Borderstyle= 2
.WindowType = 1
.AutoCenter = .T.
.pageno.value = _pageno
Endwith
if type("paPrinter") = "U" or type("pnPrinterNo") # "N"
public paPrinter(1,2),pnPrinterNo
pnPrinterNo = 1
endif
*-- 获取打印机信息,并存入数组中
nPrinterNum = APRINTERS(paPrinter)
With ThisForm.PrinterList
if nPrinterNum = 0
.value = "没有安装打印机"
else
.clear
For n = 1 to nPrinterNum
.additem(paPrinter(n,1))
Endfor
.listindex = pnPrinterNo
endif
Endwith
*-- 获取打印机的信息
thisform.GetPrinterInfo()
*-- 获取纸张及方向
thisform.papertype.caption = thisform.getpaper()
ENDPROC
*-- 改变打印机列表的事件
PROCEDURE printerlist.InteractiveChange
pnPrinterNo = this.listindex
cCurPrinter = thisform.PrinterList.value
set printer to name "&cCurPrinter"
*-- 重新获取打印机的信息及大小和方向
thisform.GetPrinterInfo
thisform.papertype.caption = thisform.GetPaper()
ENDPROC
PROCEDURE cmdok.Click
*-- 设置打印机
cCurPrinter = thisform.PrinterList.value
set printer to name "&cCurPrinter"
pnPrinterNo = thisform.PrinterList.listindex
*-- 获得打印范围
pbpage = 1
pepage = _pepage
With ThisForm.Optiongroup2
do case
case .value = 1
pbpage = 1
pepage = _pepage
case .value = 2
pbpage = _pageno
pepage = _pageno
case .value = 3
pbpage = ThisForm.pbpage.value
pepage = ThisForm.pepage.value
if pbpage > pepage or pbpage > _pepage or pbpage <= 0
messagebox("页码设置错误！",48,"警告")
thisform.pbpage.setfocus
retu
endif
endcase
Endwith
RptName = thisform.rptname
if !empty(rptname)
nCopy = thisform.copy.value
isOneByOne = thisform.check1.value
if isOneByOne && 逐份打印
for n=1 to nCopy
wait windo "正在输出打印 ..." + allt(str(n)) + "/" + allt(str(nCopy)) + "按 ESC 取消！" nowait
if inkey(1) = 27
exit
endif
report form "&RptName" nocon noeject range pbpage,pepage to print
endfor
else
nMax = (pepage-pbpage)*nCopy
i = 1
for n=pbpage to pepage && 逐页打印
for m=1 to nCopy
wait window "正在输出打印 ..." + allt(str(i)) + "/" + allt(str(nMax)) + "按 ESC 取消！" nowait
report form "&RptName" nocon noeject range n,n to print
i = i + 1
if inkey(1) = 27
i = 0
exit
endif
endfor
if i=0
exit
endif
endfor
endif
endif
thisform.release
ENDPROC
PROCEDURE command1.Click
thisform.release
ENDPROC
PROCEDURE optiongroup2.InteractiveChange
ThisForm.pbpage.enabled = IIF(this.value = 3,.T.,.F.)
ThisForm.pepage.enabled = ThisForm.pbpage.enabled
thisform.pbpage.setfocus
ENDPROC
PROCEDURE command2.Click
=sys(1037)
thisform.GetPrinterInfo
thisform.papertype.caption = thisform.GetPaper()
ENDPROC
ENDDEFINE
*-- 结束定义: printsetup
>>> 请下载该示例 dbf2excel.zip 31.3K ， 如有问题，请来信！
注：该下载包中含有的文件有：
执行程序：dbf2excel_sample.prg
自由表表：sample_item.dbf
包含文件：vb_marco.h
报表预览：RptPreview.prg
报表打印：RptPrint.prg
报表信息：DspRptInfo.prg
报表预览工具条上的8个图片文件,报表文件，表单文件，项目文件各一个
[返回] |
您的位置：首页 >> vfp教程 >> 网上文摘 >> 报表打印 >> 正文