分享
 
 
 

完美支持98、2000系统自定义打印纸张的VB代码

王朝vb·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

主要代码取自微软网站上的一篇文章,只做少许改动。

98、2000系统下已测试通过(打印机LQ-300K)

'模块modPrint

Option Explicit

Public Declare Function EnumForms Lib "winspool.drv" Alias "EnumFormsA" _

(ByVal hPrinter As Long, ByVal Level As Long, ByRef pForm As Any, _

ByVal cbBuf As Long, ByRef pcbNeeded As Long, _

ByRef pcReturned As Long) As Long

Public Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" _

(ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As Long

Public Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" _

(ByVal hPrinter As Long, ByVal pFormName As String) As Long

Public Declare Function OpenPrinter Lib "winspool.drv" _

Alias "OpenPrinterA" (ByVal pPrinterName As String, _

phPrinter As Long, ByVal pDefault As Long) As Long

Public Declare Function ClosePrinter Lib "winspool.drv" _

(ByVal hPrinter As Long) As Long

Public Declare Function DocumentProperties Lib "winspool.drv" _

Alias "DocumentPropertiesA" (ByVal hwnd As Long, _

ByVal hPrinter As Long, ByVal pDeviceName As String, _

pDevModeOutput As Any, pDevModeInput As Any, ByVal fMode As Long) _

As Long

Public Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" _

(ByVal hdc As Long, lpInitData As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _

(ByVal lpString1 As String, ByRef lpString2 As Long) As Long

' Optional functions not used in this sample, but may be useful.

Public Declare Function GetForm Lib "winspool.drv" Alias "GetFormA" _

(ByVal hPrinter As Long, ByVal pFormName As String, _

ByVal Level As Long, pForm As Byte, ByVal cbBuf As Long, _

pcbNeeded As Long) As Long

Public Declare Function SetForm Lib "winspool.drv" Alias "SetFormA" _

(ByVal hPrinter As Long, ByVal pFormName As String, _

ByVal Level As Long, pForm As Byte) As Long

' Constants for DEVMODE

Public Const CCHFORMNAME = 32

Public Const CCHDEVICENAME = 32

Public Const DM_FORMNAME As Long = &H10000

Public Const DM_ORIENTATION = &H1&

' Constants for PRINTER_DEFAULTS.DesiredAccess

Public Const PRINTER_ACCESS_ADMINISTER = &H4

Public Const PRINTER_ACCESS_USE = &H8

Public Const STANDARD_RIGHTS_REQUIRED = &HF0000

Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _

PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

' Constants for DocumentProperties() call

Public Const DM_MODIFY = 8

Public Const DM_IN_BUFFER = DM_MODIFY

Public Const DM_COPY = 2

Public Const DM_OUT_BUFFER = DM_COPY

' Custom constants for this sample's SelectForm function

Public Const FORM_NOT_SELECTED = 0

Public Const FORM_SELECTED = 1

Public Const FORM_ADDED = 2

Public Type RECTL

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Public Type SIZEL

cx As Long

cy As Long

End Type

Public Type SECURITY_DESCRIPTOR

Revision As Byte

Sbz1 As Byte

Control As Long

Owner As Long

Group As Long

Sacl As Long ' ACL

Dacl As Long ' ACL

End Type

' The two definitions for FORM_INFO_1 make the coding easier.

Public Type FORM_INFO_1

Flags As Long

pName As Long ' String

Size As SIZEL

ImageableArea As RECTL

End Type

Public Type sFORM_INFO_1

Flags As Long

pName As String

Size As SIZEL

ImageableArea As RECTL

End Type

Public Type DEVMODE

dmDeviceName As String * CCHDEVICENAME

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 * CCHFORMNAME

dmUnusedPadding As Integer

dmBitsPerPel As Long

dmPelsWidth As Long

dmPelsHeight As Long

dmDisplayFlags As Long

dmDisplayFrequency As Long

End Type

Public Type PRINTER_DEFAULTS

pDatatype As String

pDevMode As Long ' DEVMODE

DesiredAccess As Long

End Type

Public Type PRINTER_INFO_2

pServerName As String

pPrinterName As String

pShareName As String

pPortName As String

pDriverName As String

pComment As String

pLocation As String

pDevMode As DEVMODE

pSepFile As String

pPrintProcessor As String

pDatatype As String

pParameters As String

pSecurityDescriptor As SECURITY_DESCRIPTOR

Attributes As Long

Priority As Long

DefaultPriority As Long

StartTime As Long

UntilTime As Long

Status As Long

cJobs As Long

AveragePPM As Long

End Type

'判断系统是否为NT系统

Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _

(lpVersionInformation As OSVERSIONINFO) As Long

Public Type OSVERSIONINFO

dwOSVersionInfoSize As Long

dwMajorVersion As Long

dwMinorVersion As Long

dwBuildNumber As Long

dwPlatformId As Long

szCSDVersion As String * 128 ' Maintenance string for PSS usage

End Type

Public Function SelectForm(FormName As String, ByVal MyhWnd As Long) _

As Integer

Dim nSize As Long ' Size of DEVMODE

Dim pDevMode As DEVMODE

Dim PrinterHandle As Long ' Handle to printer

Dim hPrtDC As Long ' Handle to Printer DC

Dim PrinterName As String

Dim aDevMode() As Byte ' Working DEVMODE

Dim FormSize As SIZEL

Dim tmpFormName As String

Dim isNT As Boolean

Dim PaperWidth As Long, PaperHeight As Long

'在这里统一添加自定义纸张

Select Case FormName

Case "广东省发票"

With FormSize ' Desired page size

.cx = 186000

.cy = 102000

End With

PaperWidth = 10544 '15.6cm

PaperHeight = 5784 '10.2cm

Case "80列报表"

With FormSize ' Desired page size

.cx = 210000

.cy = 280000

End With

PaperWidth = 11904 '21cm

PaperHeight = 15872 '28cm

Case "40列报表"

With FormSize ' Desired page size

.cx = 210000

.cy = 140000

End With

PaperWidth = 11904 '21cm

PaperHeight = 7936 '14cm

Case "20列报表"

With FormSize ' Desired page size

.cx = 210000

.cy = 70000

End With

PaperWidth = 11904 '21cm

PaperHeight = 4008 '7cm

End Select

'不是NT直接给Printer赋值得了

If Not IsNtOs Then

Printer.Width = PaperWidth

Printer.Height = PaperHeight

SelectForm = FORM_SELECTED

Exit Function

End If

PrinterName = Printer.DeviceName ' Current printer

hPrtDC = Printer.hdc ' hDC for current Printer

SelectForm = FORM_NOT_SELECTED ' Set for failure unless reset in code.

' Get a handle to the printer.

If OpenPrinter(PrinterName, PrinterHandle, 0&) Then

' Retrieve the size of the DEVMODE.

nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, _

0&, 0&)

' Reserve memory for the actual size of the DEVMODE.

ReDim aDevMode(1 To nSize)

' Fill the DEVMODE from the printer.

nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _

aDevMode(1), 0&, DM_OUT_BUFFER)

' Copy the Public (predefined) portion of the DEVMODE.

Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))

' If FormName is "MyCustomForm", we must make sure it exists

' before using it. Otherwise, it came from our EnumForms list,

' and we do not need to check first. Note that we could have

' passed in a Flag instead of checking for a literal name.

tmpFormName = FormName

If GetFormName(PrinterHandle, FormSize, tmpFormName) = 0 Then

' Form not found - Either of the next 2 lines will work.

'FormName = AddNewForm(PrinterHandle, FormSize, "MyCustomForm")

AddNewForm PrinterHandle, FormSize, FormName

If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then

ClosePrinter (PrinterHandle)

SelectForm = FORM_NOT_SELECTED ' Selection Failed!

Exit Function

Else

SelectForm = FORM_ADDED ' Form Added, Selection succeeded!

End If

End If

' Change the appropriate member in the DevMode.

' In this case, you want to change the form name.

pDevMode.dmFormName = FormName & Chr(0) ' Must be NULL terminated!

' Set the dmFields bit flag to indicate what you are changing.

pDevMode.dmFields = DM_FORMNAME

' Copy your changes back, then update DEVMODE.

Call CopyMemory(aDevMode(1), pDevMode, Len(pDevMode))

nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _

aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)

nSize = ResetDC(hPrtDC, aDevMode(1)) ' Reset the DEVMODE for the DC.

' Close the handle when you are finished with it.

ClosePrinter (PrinterHandle)

' Selection Succeeded! But was Form Added?

If SelectForm <> FORM_ADDED Then SelectForm = FORM_SELECTED

Else

SelectForm = FORM_NOT_SELECTED ' Selection Failed!

End If

End Function

Public Function GetFormName(ByVal PrinterHandle As Long, _

FormSize As SIZEL, FormName As String) As Integer

Dim NumForms As Long, I As Long

Dim FI1 As FORM_INFO_1

Dim aFI1() As FORM_INFO_1 ' Working FI1 array

Dim Temp() As Byte ' Temp FI1 array

Dim FormIndex As Integer

Dim BytesNeeded As Long

Dim RetVal As Long

FormName = vbNullString

FormIndex = 0

ReDim aFI1(1)

' First call retrieves the BytesNeeded.

RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, NumForms)

ReDim Temp(BytesNeeded)

ReDim aFI1(BytesNeeded / Len(FI1))

' Second call actually enumerates the supported forms.

RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, BytesNeeded, _

NumForms)

Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)

For I = 0 To NumForms - 1

With aFI1(I)

If .Size.cx = FormSize.cx And .Size.cy = FormSize.cy Then

' Found the desired form

FormName = PtrCtoVbString(.pName)

FormIndex = I + 1

Exit For

End If

End With

Next I

GetFormName = FormIndex ' Returns non-zero when form is found.

End Function

Public Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, _

FormName As String) As String

Dim FI1 As sFORM_INFO_1

Dim aFI1() As Byte

Dim RetVal As Long

With FI1

.Flags = 0

.pName = FormName

With .Size

.cx = FormSize.cx

.cy = FormSize.cy

End With

With .ImageableArea

.Left = 0

.Top = 0

.Right = FI1.Size.cx

.Bottom = FI1.Size.cy

End With

End With

ReDim aFI1(Len(FI1))

Call CopyMemory(aFI1(0), FI1, Len(FI1))

RetVal = AddForm(PrinterHandle, 1, aFI1(0))

If RetVal = 0 Then

If Err.LastDllError = 5 Then

MsgBox "You do not have permissions to add a form to " & _

Printer.DeviceName, vbExclamation, "Access Denied!"

Else

MsgBox "Error: " & Err.LastDllError, , "Error Adding Form"

'MsgBox "Error: " & Err.LastDllError, "Error Adding Form"

End If

AddNewForm = "none"

Else

AddNewForm = FI1.pName

End If

End Function

Public Sub PrintTest()

' Print two test pages to confirm the page size.

Printer.Print "Top of Page 1."

Printer.NewPage

' Spacing between lines should reflect the chosen page height.

Printer.Print "Top of Page 2. - Check the page Height (Length.)"

Printer.EndDoc

MsgBox "Check Printer " & Printer.DeviceName, vbInformation, "Done!"

End Sub

Public Function PtrCtoVbString(ByVal Add As Long) As String

Dim sTemp As String * 512, X As Long

X = lstrcpy(sTemp, ByVal Add)

If (InStr(1, sTemp, Chr(0)) = 0) Then

PtrCtoVbString = ""

Else

PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)

End If

End Function

Public Function IsNtOs() As Boolean

Dim ver As OSVERSIONINFO

ver.dwOSVersionInfoSize = 148

GetVersionEx ver

With ver

Select Case .dwPlatformId

Case 0, 1

IsNtOs = False

Case 2

IsNtOs = True

End Select

End With

End Function

Public Function UseForm(FormName As String, sHwnd As Long) As Integer

Dim RetVal As Integer

Dim FormSize As SIZEL ' Size of desired form

RetVal = SelectForm(FormName, sHwnd) '选择纸张类型

UseForm = RetVal

Select Case RetVal

Case FORM_NOT_SELECTED ' 0

' 选择纸张失败!

'MsgBox "Unable to retrieve From name", vbExclamation, _

'"Operation halted!"

Case FORM_SELECTED ' 1

' 选择成功!

'PrintTest ' Comment this line to avoid printing

Case FORM_ADDED ' 2

' 添加并选择成功.

'PrintTest ' Comment this line to avoid printing

End Select

End Function

'调用,在Form1上放置Command1、Command2,复制下列代码:

Option Explicit

Private Sub Command1_Click()

Dim FormName As String, RetValue As Integer

'自定义打印纸张

FormName = "广东省发票"

RetValue = UseForm(FormName, Me.hwnd)

'If RetValue = 0 Then GoTo errPrint

PrintTest

End Sub

Private Sub Command2_Click()

Dim FormName As String, RetValue As Integer

'自定义打印纸张

FormName = "80列报表"

RetValue = UseForm(FormName, Me.hwnd)

'If RetValue = 0 Then GoTo errPrint

PrintTest

End Sub

Private Sub Form_Load()

Command1.Caption = "打印发票"

Command2.Caption = "打印报表"

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有