自定義紙張大小的問題!急!!!!

dongdony 2003-12-06 02:19:55
用以下函數自定義紙張大小,但打印的內容不在原來的位置上了,比如用A4的紙打在紙的左上端,但自定義紙張後並沒在打在紙的左上端,或者根本沒打出來,我用的是虛擬打印機,請高手幫忙解決問題!
Public Function mySetPrinter(ByVal prnName As String, _
Optional ByVal eOrientation As typeOrient = 0, _
Optional ByVal iDmpaper As Integer = 0, _
Optional ByVal iDmpaperLength As Single = 0, _
Optional ByVal iDmpaperWidth As Single = 0) _
As Boolean

Dim bDevMode() As Byte
Dim bPrinterInfo2() As Byte
Dim hPrinter As Long
Dim lResult As Long
Dim nSize As Long
Dim sPrnName As String

Dim dm As DEVMODE
Dim olddm As DEVMODE
Dim pd As PRINTER_DEFAULTS
Dim pi2 As PRINTER_INFO_2

On Error GoTo Err_Proc

sPrnName = prnName
pd.DesiredAccess = PRINTER_ALL_ACCESS

If OpenPrinter(sPrnName, hPrinter, pd) Then
Call GetPrinter(hPrinter, 2&, 0&, 0&, nSize)
ReDim bPrinterInfo2(1 To nSize) As Byte
lResult = GetPrinter(hPrinter, 2, bPrinterInfo2(1), nSize, nSize)
Call CopyMemory(pi2, bPrinterInfo2(1), Len(pi2))
nSize = DocumentProperties(0&, hPrinter, sPrnName, 0&, 0&, 0)
ReDim bDevMode(1 To nSize)

If pi2.pDevMode Then
Call CopyMemory(bDevMode(1), ByVal pi2.pDevMode, Len(dm))
Else
Call DocumentProperties(0&, hPrinter, sPrnName, bDevMode(1), 0&, DM_OUT_BUFFER)
End If

Call CopyMemory(dm, bDevMode(1), Len(dm))
Call CopyMemory(olddm, bDevMode(1), Len(olddm))

With dm
If eOrientation <> 0 Then
.dmOrientation = eOrientation
.dmFields = DM_ORIENTATION
End If
If iDmpaper <> 0 And iDmpaper <> vbPRPSUser Then
.dmPaperSize = iDmpaper
.dmFields = DM_PAPERSIZE
End If
If iDmpaper = vbPRPSUser Then
.dmFields = DM_PAPERLENGTH Or DM_PAPERWIDTH
.dmPaperLength = iDmpaperLength
.dmPaperWidth = iDmpaperWidth
End If
End With

Call CopyMemory(bDevMode(1), dm, Len(dm))

Call DocumentProperties(0&, hPrinter, sPrnName, _
bDevMode(1), bDevMode(1), DM_IN_BUFFER Or _
DM_OUT_BUFFER)

pi2.pDevMode = VarPtr(bDevMode(1))

lResult = SetPrinter(hPrinter, 2, pi2, 0&)
Call ClosePrinter(hPrinter)
mySetPrinter = True
Else
mySetPrinter = False
End If

Exit Function

Err_Proc:
mySetPrinter = False
End Function

Public Function ChgPageSize(ByVal prnName As String, _
Optional ByVal pagesize As Integer = vbPRPSUser, _
Optional ByVal pagewidth As Single = 0, _
Optional ByVal pageheight As Single = 0) _
As Boolean

On Error GoTo Err_Proc

ChgPageSize = mySetPrinter(prnName, , pagesize, pagewidth * 10, pageheight * 10)

Exit Function
Err_Proc:
ChgPageSize = False
End Function
...全文
18 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

809

社区成员

发帖
与我相关
我的任务
社区描述
VB 多媒体
社区管理员
  • 多媒体
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧