📄 printdlg.frm
字号:
Left = 216
TabIndex = 9
Top = 570
Width = 756
End
Begin VB.OptionButton OptPrintAll
Caption = "全部(&A)"
Height = 204
Left = 216
TabIndex = 8
Top = 288
Width = 1068
End
Begin GACALENDARLibCtl.SpinEdit SpiCount
Height = 285
Index = 1
Left = 1380
OleObjectBlob = "printDlg.frx":015A
TabIndex = 13
Top = 1140
Width = 855
End
Begin VB.Label Label6
Caption = "至(&T)"
Height = 255
Left = 780
TabIndex = 12
Top = 1185
Width = 495
End
Begin VB.Label Label5
Caption = "由(&F)"
Height = 255
Left = 780
TabIndex = 10
Top = 825
Width = 570
End
End
Begin VB.Frame FraPrint
Caption = "输出到"
Height = 1560
Index = 0
Left = 120
TabIndex = 0
Top = 105
Width = 5805
Begin VB.CheckBox ChkCatenaPrint
Caption = "连续打印"
Height = 195
Left = 4290
TabIndex = 38
Top = 690
Width = 1065
End
Begin VB.CheckBox ChkTaoDa
Caption = "套打(&T)"
Height = 255
Left = 4290
TabIndex = 6
Top = 960
Width = 1155
End
Begin VB.ComboBox CboFile
Height = 300
Left = 1350
Style = 2 'Dropdown List
TabIndex = 5
Top = 1080
Width = 2415
End
Begin VB.CheckBox ChkColorPrint
Caption = "彩色打印(&C)"
Height = 315
Left = 4290
TabIndex = 7
Top = 1200
Width = 1365
End
Begin VB.CommandButton CmdAttrib
Caption = "属性(&R)"
Height = 300
Left = 3810
TabIndex = 3
Top = 312
Width = 972
End
Begin VB.OptionButton OptFile
Caption = "文件(&F)"
Height = 276
Left = 90
TabIndex = 4
Top = 1110
Width = 1080
End
Begin VB.OptionButton OptPrinter
Caption = "打印机(&P)"
Height = 228
Left = 90
TabIndex = 1
Top = 360
Width = 1188
End
Begin VB.ComboBox CboPrinterName
Height = 300
Left = 1350
Style = 2 'Dropdown List
TabIndex = 2
Top = 312
Width = 2412
End
Begin VB.Label LblStatus
Height = 195
Left = 180
TabIndex = 37
Top = 750
Width = 2835
End
End
End
Attribute VB_Name = "frmPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'功能:帐册,报表打印对话框
'作者:李鹏
'日期:1998年8月
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_ORIENTATION = &H1&
Private Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (ByVal hWnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, pDevModeOutput As DEVMODE, pDevModeInput As DEVMODE, ByVal fMode As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Private Type PageInfo
iColPageCount As Integer
iRowPageCount As Integer
lngPageWidth() As Long
lngPageHeight() As Long
iRowBegin() As Long
iColBegin() As Long
iRowCount() As Long
iColCount() As Long
End Type
Private Type DEVMODE
dmDeviceName As String * 32
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * 32
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As DEVMODE
DesiredAccess As Long
End Type
Const DM_COPY = 2
Const DM_MODIFY = 8
Const DM_PROMPT = 4
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private blnIsOK As Boolean
Private mintOldOrientation As Integer '数据库打印方向
Private mlngOldPaperSize As Long '数据库纸张尺寸
Private mlngOldPaperLength As Long '数据库纸张长度
Private mlngOldPaperWidth As Long '数据库纸张宽度
Private StrFileName(0 To 17) As String
Private mDeviceName As String '打印机名
Private mPrintRange As Integer '打印范围 0-全部,1-页
Private mIsColorPrint As Boolean '是否彩色打印
Private mBeginPagePrint As Long '打印开始页数
Private mEndPagePrint As Long '打印结束页数
Private mCopiesPrint As Integer '打印份数
Private mIsPagebyPage As Boolean '是否逐份打印
Private mIsDoublePrint As Boolean '是否双面打印
Private mIsPrintByOrderOne As Boolean '是否按顺序1打印
Private mIsPrintbyPrderTwo As Boolean '是否按顺序2打印
Private mIsPrintOnPrinter As Boolean '是否按打印机打印
Private mStrFileName As String '按文件输出时的文件名
Private mintFileType As Integer '文件类型号
Private mintFileIndex As Integer '文件子类型号
Private mintType As Integer '1 报表 2 帐册
Private mblnIsTaoDa As Boolean '是否套打
Private mblnLianDa As Boolean '是否连续打印
Private mblnFixPrint As Boolean '是否固定打印
Private mstrOld As String
Private mlngPrintSetupID As Long '打印ID
Private strX(0 To 20) As String
Private strY(0 To 20) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 公共接口
Public Function ShowFrmPrint(Optional ByVal intBeginPage As Long = 1, Optional ByVal intEndPage As Long = 1, Optional ByVal lngPrintSetupID As Long = 0, Optional ByVal intType As Integer = 1, Optional ByVal blnFix As Boolean = False) As Boolean
Dim x As Printer
mintType = intType
mlngPrintSetupID = lngPrintSetupID
mBeginPagePrint = intBeginPage
mEndPagePrint = intEndPage
mblnFixPrint = blnFix
'判断打印机
For Each x In Printers
If x.DeviceName <> "Rendering Subsystem" Then
CboPrinterName.AddItem x.DeviceName
End If
Next
If CboPrinterName.ListCount = 0 Then
Utility.ShowMsg Me.hWnd, "未安装打印机!", vbOKOnly + vbExclamation, "打印"
cmdOk.Enabled = False
Exit Function
Else
CboPrinterName.Text = CboPrinterName.list(0)
End If
CboPrinterName.Text = Printer.DeviceName
Me.Show vbModal
ShowFrmPrint = blnIsOK
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 公共属性
'
Public Property Get GintFileType() As Integer
GintFileType = mintFileType
End Property
Public Property Get GintFileIndex() As Integer
GintFileIndex = mintFileIndex
End Property
Public Property Get GStrFileName() As String
GStrFileName = mStrFileName
End Property
Public Property Get GIsPrintOnPrinter() As Boolean
GIsPrintOnPrinter = mIsPrintOnPrinter
End Property
Public Property Let GIsPrintOnPrinter(ByVal IsPrintOnPrinter1 As Boolean)
mIsPrintOnPrinter = IsPrintOnPrinter1
End Property
Public Property Get GIsPrintbyPrderTwo() As Boolean
GIsPrintbyPrderTwo = mIsPrintbyPrderTwo
End Property
Public Property Let GIsPrintbyPrderTwo(ByVal IsPrintbyPrderTwo1 As Boolean)
mIsPrintbyPrderTwo = IsPrintbyPrderTwo1
End Property
Public Property Get GIsPrintByOrderOne() As Boolean
GIsPrintByOrderOne = mIsPrintByOrderOne
End Property
Public Property Let GIsPrintByOrderOne(ByVal IsPrintByOrderOne1 As Boolean)
mIsPrintByOrderOne = IsPrintByOrderOne1
End Property
Public Property Get GIsDoublePrint() As Boolean
GIsDoublePrint = mIsDoublePrint
End Property
Public Property Let GIsDoublePrint(ByVal IsDoublePrint1 As Boolean)
mIsDoublePrint = IsDoublePrint1
End Property
Public Property Get GIsPagebyPage() As Boolean
GIsPagebyPage = mIsPagebyPage
End Property
Public Property Let GIsPagebyPage(ByVal IsPagebyPage1 As Boolean)
mIsPagebyPage = IsPagebyPage1
End Property
Public Property Get GCopiesPrint() As Integer
GCopiesPrint = mCopiesPrint
End Property
Public Property Let GCopiesPrint(ByVal CopiesPrint1 As Integer)
mCopiesPrint = CopiesPrint1
End Property
Public Property Get GEndPagePrint() As Integer
GEndPagePrint = mEndPagePrint
End Property
Public Property Let GEndPagePrint(ByVal EndPagePrint1 As Integer)
mEndPagePrint = EndPagePrint1
End Property
Public Property Get GBeginPagePrint() As Integer
GBeginPagePrint = mBeginPagePrint
End Property
Public Property Let GBeginPagePrint(ByVal BeginPagePrint1 As Integer)
mBeginPagePrint = BeginPagePrint1
End Property
Public Property Get GIsColorPrint() As Boolean
GIsColorPrint = mIsColorPrint
End Property
Public Property Let GIsColorPrint(ByVal IsColorPrint1 As Boolean)
mIsColorPrint = IsColorPrint1
End Property
Public Property Get GPrintRange() As Integer
GPrintRange = mPrintRange
End Property
Public Property Let GPrintRange(ByVal PrintRange1 As Integer)
mPrintRange = PrintRange1
End Property
Public Property Get GDeviceName() As String
GDeviceName = mDeviceName
End Property
Public Property Let GDeviceName(ByVal DeviceName1 As String)
mDeviceName = DeviceName1
End Property
Public Property Get GblnIsTaoda() As Boolean
GblnIsTaoda = mblnIsTaoDa
End Property
Public Property Let GblnIsTaoda(ByVal blnIsTaoda1 As Boolean)
mblnIsTaoDa = blnIsTaoda1
End Property
Public Property Get GblnLianda() As Boolean
GblnLianda = mblnLianDa
End Property
Public Property Let GblnLianda(ByVal blnIsTaoda1 As Boolean)
mblnLianDa = blnIsTaoda1
End Property
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 控件过程
'
Private Sub CboPrinterName_Click()
Dim strCaption As String
Dim x As Printer
For Each x In Printers
If x.DeviceName = CboPrinterName.Text Then
strCaption = "输出端口：" & x.Port
Exit For
End If
Next
LblStatus.Caption = strCaption
End Sub
Private Sub ChkCopies_Click()
If ChkCopies.Value = 1 Then
Label1(0).Caption = "2"
Label1(2).Caption = "4"
Label1(3).Caption = "3"
Label1(4).Caption = "6"
Label1(5).Caption = "5"
Else
Label1(0).Caption = "1"
Label1(1).Caption = "1"
Label1(2).Caption = "2"
Label1(3).Caption = "2"
Label1(4).Caption = "3"
Label1(5).Caption = "3"
End If
End Sub
Private Sub ChkDouble_Click()
If ChkDouble.Value = 1 Then
ChkOrder1.Enabled = True
ChkOrder2.Enabled = True
Else
ChkOrder1.Enabled = False
ChkOrder2.Enabled = False
End If
End Sub
Private Sub ChkOrder1_Click()
If ChkOrder1.Value = 1 Then
lblDuplex(2).Caption = "5"
lblDuplex(1).Caption = "3"
lblDuplex(0).Caption = "1"
Else
lblDuplex(2).Caption = "1"
lblDuplex(1).Caption = "3"
lblDuplex(0).Caption = "5"
End If
End Sub
Private Sub ChkOrder2_Click()
If ChkOrder2.Value = 1 Then
lblDuplex(5).Caption = "6"
lblDuplex(4).Caption = "4"
lblDuplex(3).Caption = "2"
Else
lblDuplex(5).Caption = "2"
lblDuplex(4).Caption = "4"
lblDuplex(3).Caption = "6"
End If
End Sub
Private Sub CmdAttrib_Click()
Dim iPrinter As Integer
Dim prnDefault As Printer
Dim lngHandle As Long
Dim pDefault As PRINTER_DEFAULTS
Dim iIndex As Integer
Dim blnRetValue As Boolean
Dim ustPageInfo As PageInfo
Dim l As Long
Dim l1 As Long
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -