加载中…
个人资料
  • 博客等级:
  • 博客积分:
  • 博客访问:
  • 关注人气:
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
正文 字体大小:

vb中直接调用打印机打印

(2008-11-12 20:23:52)
标签:

杂谈

分类: webservice,vba,vb,wml

'打印方向设置
  Public Enum PrinterOrientationConstants
          OrientPortrait = 1
          OrientLandscape = 2
  End Enum
  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 Long
          DesiredAccess   As Long
  End Type
  Private Type PRINTER_INFO_2
          pServerName   As Long
          pPrinterName   As Long
          pShareName   As Long
          pPortName   As Long
          pDriverName   As Long
          pComment   As Long
          pLocation   As Long
          pDevMode   As Long
          pSepFile   As Long
          pPrintProcessor   As Long
          pDataType   As Long
          pParameters   As Long
          pSecurityDescriptor   As Long
          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
   
  Private Const DM_IN_BUFFER = 8
  Private Const DM_OUT_BUFFER = 2
  Private Const DM_ORIENTATION = &H1
   
  Private Const PRINTER_ACCESS_ADMINISTER = &H4
  Private Const PRINTER_ACCESS_USE = &H8
  Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
  Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
          PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
   
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
          (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
   
  Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
          "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As _
          Long, pDefault As Any) As Long
   
  Private Declare Function ClosePrinter Lib "winspool.drv" _
          (ByVal hPrinter As Long) As Long
   
  Private 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
   
  Private Declare Function GetPrinter Lib "winspool.drv" _
          Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
          pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long
   
  Private Declare Function SetPrinter Lib "winspool.drv" _
          Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
          pPrinter As Any, ByVal Command As Long) As Long
   
  '------------------------------------------------------------------------------
  Function SetDefaultPrinterOrientation(ByVal eOrientation As _
          PrinterOrientationConstants) As Boolean                                                     '1   纵向,    横向
           
          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 pd     As PRINTER_DEFAULTS
          Dim pi2     As PRINTER_INFO_2
   
           
          sPrnName = Printer.DeviceName
         
          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))
                  With dm
                         
                          .dmOrientation = eOrientation
                          .dmFields = DM_ORIENTATION
                  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)
                  SetDefaultPrinterOrientation = True
          Else
                  SetDefaultPrinterOrientation = False
          End If
   
  End Function
  Private Sub Command1_Click()
    SetDefaultPrinterOrientation (2)


    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    conn.ConnectionString = "Driver={sql server};server=222.195.150.228;uid=sa;pwd=pimm;database=hope"
    conn.ConnectionTimeout = 30
    conn.Open
    MsgBox "connected to sqlserver"
    rs.Open "select name from student", conn, adOpenStatic, adLockReadOnly, adCmdText
    While Not rs.EOF
    MsgBox rs.Fields(0).Value
    lblname.Caption = rs.Fields(0).Value
    Form1.PrintForm
    rs.MoveNext
    Wend
    rs.Close

End Sub

Private Sub Command2_Click()
 SetDefaultPrinterOrientation (2)
'从文件中读取数据
    Dim fso As Object  'FileSystemObject
    Dim txt As Object
    Dim str As String
    Dim str2 As String
   
    Dim subs
    Dim subs2
    Dim str_path As String
    Dim col_Text As Collection
    Dim k As Integer
    str_path = App.Path & "\1.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.OpenTextFile(str_path, 1, True)
    Set col_Text = New Collection
    Do
        If txt.AtEndOfStream Then Exit Do
        col_Text.Add txt.ReadLine
    Loop
    Dim i, j As Integer
    i = col_Text.Count
    j = 1
    While j <= i
        str = col_Text.Item(j)
        If j = i Then
            str2 = ""
            subs = Split(str, ",")
            lblname.Caption = subs(0)
            lblcer.Caption = subs(1)
            lblname2.Caption = ""
            lblcer2.Caption = ""
        Else
            str2 = col_Text.Item(j + 1)
            subs = Split(str, ",")
            lblname.Caption = subs(0)
            lblcer.Caption = subs(1)
            subs2 = Split(str2, ",")
            lblname2.Caption = subs2(0)
            lblcer2.Caption = subs2(1)
        End If
        j = j + 2
        Form1.PrintForm
    Wend
    Printer.DrawStyle = vbDash
    Printer.DrawWidth = 1

End Sub

Private Sub Form_Load()
SetDefaultPrinterOrientation (2) '设置横向打印
'从文件中读取数据
    Dim fso As Object  'FileSystemObject
    Dim txt As Object
    Dim str As String
    Dim str2 As String
   
    Dim subs
    Dim subs2
    Dim str_path As String
    Dim col_Text As Collection
    Dim k As Integer
    str_path = App.Path & "\1.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.OpenTextFile(str_path, 1, True)
    Set col_Text = New Collection
    Do
        If txt.AtEndOfStream Then Exit Do
        col_Text.Add txt.ReadLine
    Loop
    Dim i, j As Integer
    i = col_Text.Count
    j = 1
    While j <= i
        str = col_Text.Item(j)
        If j = i Then
            str2 = ""
            subs = Split(str, ",")
            lblname.Caption = subs(0)
            lblcer.Caption = subs(1)
            lblname2.Caption = ""
            lblcer2.Caption = ""
        Else
            str2 = col_Text.Item(j + 1)
            subs = Split(str, ",")
            lblname.Caption = subs(0)
            lblcer.Caption = subs(1)
            subs2 = Split(str2, ",")
            lblname2.Caption = subs2(0)
            lblcer2.Caption = subs2(1)
        End If
        j = j + 2
        Form1.PrintForm  '打印
    Wend
    Printer.DrawStyle = vbDash
    Printer.DrawWidth = 1

End Sub

0

阅读 收藏 喜欢 打印举报/Report
  

新浪BLOG意见反馈留言板 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑

新浪公司 版权所有