读书人

VB打印有关问题怎么自定义纸张大小

发布时间: 2012-02-09 18:22:27 作者: rapoo

VB打印问题,如何自定义纸张大小

   因为根据客户的需要,需打印各种发票,根据发票尺寸不同设置不同大小的纸张,能否通过代码设置打印机的纸张尺寸大小,如果可以,请问怎么实现。



[解决办法]

兄弟,看在都是学VB的份上,我可以帮你
来CSDN这么久,一直都没有完整的帮别人解决过问题!

这个问题我可以帮你解决,不过100分是不是少了一点?

你可以到网上搜一下,
VB自定义打印的,很少看到
我1年多以前,也和你一样,在网上找这方面的资料,都没有找到,
最后一个兄弟帮了我,给我一个帮助,然后在那基础上,我实现了VB自定义打印
也是打印票据(用针式打印机,连续打)
如果需要,就联系我,另外,多给一点分!
lvrfly@sohu.com

[解决办法]
楼上几位怎么搞得这么复杂。。关于VB自定义打印尺寸的代码msdn上就有。搜索AddForm这个函数就知道了。
我贴一段例子给你把


新建一个窗体,上面放上一个list控件和3个Command控件。然后填入如下代码:

Option Explicit

Private Sub Command1_Click()
Dim FormName As String

FormName = "MyCustomForm " ' Use special, user-defined form.
UseForm FormName
End Sub

Private Sub Command2_Click()
Dim FormName As String

' Get FormName from the ListBox.
On Error GoTo ListBoxERR ' Trap for no selection.
FormName = Mid(List1.Text, 1, InStr(1, List1.Text, " - ") - 1)
On Error GoTo 0 ' Turn off Error trap.

UseForm FormName

Exit Sub
ListBoxERR:
MsgBox "Select a printer from the ListBox before using this option. ", _
vbExclamation
End Sub

Private Sub Command3_Click()
Dim RetVal As Long
Dim PrinterHandle As Long ' Handle to printer
Dim PrinterName As String
Dim FormName As String
Dim Continue As Long

' Delete form that is selected in ListBox.
PrinterName = Printer.DeviceName ' Current printer
If OpenPrinter(PrinterName, PrinterHandle, 0&) Then

On Error GoTo ListBoxERR ' Trap for no selection.
FormName = Mid(List1.Text, 1, InStr(1, List1.Text, " - ") - 1)
On Error GoTo 0 ' Turn off Error trap.

Continue = MsgBox( "Are you sure you want to permanently remove " & _
FormName & " from " & PrinterName & "? ", vbYesNo)
If Continue = vbYes Then
RetVal = DeleteForm(PrinterHandle, FormName & Chr(0))
If RetVal <> 0 Then ' DeleteForm succeeded.
List1.Clear ' Reflect the deletion in the ListBox.
Form_Load ' Rebuild the list.
MsgBox FormName & " deleted! ", vbInformation, "Success! "
Else
MsgBox FormName & " not deleted! " & vbCrLf & vbCrLf & _
"Error code: " & Err.LastDllError, vbInformation, "Failure! "
End If
End If
ClosePrinter (PrinterHandle)
End If

Exit Sub
ListBoxERR:
MsgBox "Select a printer from the ListBox before using this option. ", _
vbExclamation
ClosePrinter (PrinterHandle)
End Sub

Private Sub Form_Load()
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 BytesNeeded As Long
Dim PrinterName As String ' Current printer
Dim PrinterHandle As Long ' Handle to printer
Dim FormItem As String ' For ListBox
Dim RetVal As Long
Dim FormSize As SIZEL ' Size of desired form
Printer.ScaleMode = 6
Debug.Print Printer.ScaleWidth, Printer.ScaleHeight
PrinterName = Printer.DeviceName ' Current printer


If OpenPrinter(PrinterName, PrinterHandle, 0&) Then

With FormSize ' Desired page size
.cx = 214000
.cy = 216000
End With
ReDim aFI1(1)
RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, _
NumForms)
ReDim Temp(BytesNeeded)
ReDim aFI1(BytesNeeded / Len(FI1))
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)
' List name and size including the count (index).
FormItem = PtrCtoVbString(.pName) & " - " & .Size.cx / 1000 & _
" mm X " & .Size.cy / 1000 & " mm ( " & I + 1 & ") "
List1.AddItem FormItem
End With
Next I
ClosePrinter (PrinterHandle)
End If


End Sub

Private Sub UseForm(FormName As String)
Dim RetVal As Integer

RetVal = SelectForm(FormName, Me.hwnd)
Select Case RetVal
Case FORM_NOT_SELECTED ' 0
' Selection failed!
MsgBox "Unable to retrieve From name ", vbExclamation, _
"Operation halted! "
Case FORM_SELECTED ' 1
' Selection succeeded!
PrintTest ' Comment this line to avoid printing
Case FORM_ADDED ' 2
' Form added and selected.
List1.Clear ' Reflect the addition in the ListBox
Form_Load ' by rebuilding the list.
End Select
End Sub



[解决办法]
TO 楼主
打印机的纸张设置只是一次性的,只需要在打印机属性中手动定义一下就可以,不必大段代码设定.

因此我觉得更值得关注的问题倒是如何在程序中选择打印机中已经设定好的纸张类型.
从而可以作到打印不同类型发票的时候自动切换纸形

如果楼主对于如何选择纸形有兴趣的话可以参考:
http://community.csdn.net/Expert/topic/5587/5587585.xml?temp=6.509036E-02
[解决办法]


'添加新的页面格式
Public Function AddNewForm(FormWidth As Integer, FormHeight As Integer, FormName As String) As String
Dim FI1 As sFORM_INFO_1
Dim aFI1() As Byte
Dim RetVal As Long
Dim PrinterHandle As Long
Dim flg As Long
flg = OpenPrinter(Printer.DeviceName, PrinterHandle, 0&)

With FI1
.Flags = 0
.pname = FormName
With .Size
.cx = Val(FormWidth) * 1000
.cy = Val(FormHeight) * 1000
End With
With .ImageableArea
.Left = 0
.Top = 0
.Right = FI1.Size.cx
.Bottom = FI1.Size.cy
End With
End With
If GetFormName(PrinterHandle, FI1.Size, FormName) = vbNullString Then

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 "
End If
AddNewForm = "none "
Else
AddNewForm = FI1.pname
End If
Else
AddNewForm = GetFormName(PrinterHandle, FI1.Size, FormName)
End If
End Function

'获取页面格式
Public Function GetFormName(ByVal PrinterHandle As Long, FormSize As SIZEL, FormName As String) As String


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 = FormName ' Returns non-zero when form is found.
End Function

'选择页面格式
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

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))

' 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?
SelectForm = FORM_SELECTED
Else
SelectForm = FORM_NOT_SELECTED ' Selection Failed!
End If
End Function

Public Function Delete(ByVal pFormName As String)
Dim PrinterHandle As Long
Dim flg As Long
flg = OpenPrinter(Printer.DeviceName, PrinterHandle, 0&)

DeleteForm PrinterHandle, pFormName
End Function

读书人网 >VB

热点推荐