rptprint.prg

功能模块:报关操作,运输操作,报关查询,运输查询

*-- 程序名称：RptPrint.prg
*-- 程序功能：以自定义的对话框显示报表的打印设置，以取代系统打印设置的一些不足
*-- 使用方法：RptPrint ( [] )
*　 　　或者：do RptPrint [ with ]
*-- 程序说明：cReportName 为 报表文件名（无须带扩展名），如果省略的话，则可显示设置对话框
*　　　　　　 报表的扩展名以 frx 为准
*-- 编写日期：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 = "打印机名(\",;
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 = "全部(\",;
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 = "当前页(\",; 
Option2.Height =16 ,;
Option2.Left = 82, ;
Option2.Style = 0, ;
Option2.Top = 5, ;
Option2.Width = 81, ;
Option2.AutoSize = .T., ;
Option2.Name = "Option2", ;
Option3.Caption = "页码(\",; 
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 = "份数(\", ;
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 = "打印机设置(\",; 
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