用printer方法调用不同的打印机驱动(UP有分)

Question

偶在一台计算机上安装了一块扩并口卡，现在需要在程序中调用不同的打印机打印不同的内容（这几台打印机连接在不同的口上《一般包括LPT1、LPT2和LPT3三个口》）。而现在问题是printer只能调用默认打印机，无法选择。不知到能不能选择打印机（用printer方法）？

Answer 1

没用过打印机，恰好昨天看一个视频讲到一点不知道有没有用Printers 集合
可获取有关系统上所有可用打印机的信息。
格式
Printer
Printers(打印机编号)  '打印机编号表示从 0 到 Printers.Count-1 之间的整数。

Answer 2

以前用过调用打印机名称的方式打印（采用ESC/P指令），不存在增加不增加新打印机的问题，只要能找到预先定义好的打印机名称就行了，现在觉得printer方法不错，就是只能调用缺省打印机，我不可能要打哪台就将哪台打印机设为缺省值吧，这样很容易出问题的

Answer 3

理想的情况是这样：
Option Explicit
Dim myprinter() As Printer
Private Sub Form_Load()
    Dim a As Printer, i As Long
    For Each a In Printers
        ReDim Preserve myprinter(i)
        List1.AddItem a.DeviceName
        Set myprinter(i) = a
        i = i + 1
    Next
End Sub
'改变当前打印机
Private Sub List1_Click()
    Set Printer = myprinter(List1.ListIndex)
    MsgBox Printer.DeviceName
End Sub但是，有时候不能成功，这时候就只能抛弃 Printer对象，用api进行打印了

Answer 4

bbhere(阿忠(baby,i'll be right here waiting for you)) 他的方法可以解决.
我以前做过,也是用Printers集做的.你试试

Answer 5

回复人： rainstormmaster(暴风雨 v2.0) ( ) 信誉：234  2005-12-16 10:35:00  得分: 0  用API就麻烦的去了
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
 回复人： xiaoMONKEY(小猴) ( ) 信誉：78  2005-12-16 10:35:00  得分: 0  
 
 
   bbhere(阿忠(baby,i'll be right here waiting for you)) 他的方法可以解决.
我以前做过,也是用Printers集做的.你试试  
能否贴出例子看看？ 

Answer 6

rainstormmaster(暴风雨 v2.0)
也不失为一个办法，帮你顶一下！

Answer 7

打印时出现一个打印机选择窗体就可以了，
然后set Printer = 打印机名就可以了。

Answer 8

具体方法：
列出所有打印机：
Dim Tt As Printer
For Each Tt In Printers
    combo1.AddItem Tt.DeviceName
Next
选择打印机后：
Private Sub Combo1_Click()
Dim T As Printer
For Each T In Printers
    If T.DeviceName = Combo1.Text Then
        Set Printer = T
        Exit For
    End If
Next
End Sub

Answer 9

Set Printer = myprinter(List1.ListIndex)与Set Printer = T
语句的作用是否是将该打印机设为默认打印机?我的系统是一台电脑连接三台打印机和一个承重显示仪表,称一样物体,就的三台打印机依次打印设定好的不同的内容

Answer 10

是将打印机作为VB程序的当前打印机.
在98以上的系统vb程序是不会改变windows的默认打印机的。

Answer 11

rainstormmaster, zfl2k(风) 正解。

Answer 12

回复人： rainstormmaster(暴风雨 v2.0) ( ) 信誉：238  2005-12-16 10:35:05  得分: 0  
 
 
   
理想的情况是这样：
Option Explicit
Dim myprinter() As Printer
Private Sub Form_Load()
    Dim a As Printer, i As Long
    For Each a In Printers
        ReDim Preserve myprinter(i)
        List1.AddItem a.DeviceName
        Set myprinter(i) = a
        i = i + 1
    Next
End Sub
'改变当前打印机
Private Sub List1_Click()
    Set Printer = myprinter(List1.ListIndex)
    MsgBox Printer.DeviceName
End Sub但是，有时候不能成功，这时候就只能抛弃 Printer对象，用api进行打印了  
********************************************************* 现在出现用printer打印不成功的问题了，看来只能采用API来打印了，
各位，有没有例子啊？

Answer 13

//现在出现用printer打印不成功的问题了，看来只能采用API来打印了出现这种结果很正常，vb的printer对象封装的不是太好
这样：
    Dim dm As DEVMODE
    Dim di As DOCINFO
    Dim ret As Long
    Dim hPDC As Long    
    Dim i As Long
    
'    创建打印设备
    hPDC = CreateDC(0, "打印机名称", 0, dm)
   
    di.cbSize = Len(di)
    di.lpszDocName = "Jihui"
    di.lpszOutput = ""
    '开始打印
    ret = StartDoc(hPDC, di)
    
    For i = 1 To 2
        
        ret = StartPage(hPDC)
        ret = TextOut(hPDC, 10, 10, "HelloWorld", 10)
        ret = EndPage(hPDC)
    Next i
    '结束打印
    ret = EndDoc(hPDC)    
    ret = DeleteDC(hPDC)声明你自己添加吧

Answer 14

Option Explicit   Private Const LF_FACESIZE = 32   Private Type LOGFONT
      lfHeight As Integer
      lfWidth As Integer
      lfEscapement As Long
      lfOrientation As Long
      lfWeight As Long
      lfItalic As Byte
      lfUnderline As Byte
      lfStrikeOut As Byte
      lfCharSet As Byte
      lfOutPrecision As Byte
      lfClipPrecision As Byte
      lfQuality As Byte
      lfPitchAndFamily As Byte
      lfFaceName As String * LF_FACESIZE
   End Type   Private Type DOCINFO
      cbSize As Long
      lpszDocName As String
      lpszOutput As String
      lpszDatatype As String
      fwType As Long
   End Type   Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
   Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
   Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
   Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
   Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
   Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long   ' or Boolean
   Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long
   Private Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) As Long
   Private Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) As Long
   Private Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) As Long   Const DESIREDFONTSIZE = 12     ' Could use variable, TextBox, etc.   Private Sub Command2_Click()
   ' Print using API calls only
      Dim OutString As String  'String to be rotated
      Dim lf As LOGFONT        'Structure for setting up rotated font
      Dim temp As String       'Temp string var
      Dim result As Long       'Return value for calling API functions
      Dim hOldfont As Long     'Hold old font information
      Dim hPrintDc As Long     'Handle to printer dc
      Dim hFont As Long        'Handle to new Font
      Dim di As DOCINFO        'Structure for Print Document info
      
      Dim hsize As Integer     '字体大小
      Dim vsize As Integer     '放大缩小比例
      Dim Char_Type As String  '打印字体
      
      hsize = 10
      vsize = 1
      Char_Type = "黑体"      OutString = "World你好！"   'Set string to be rotated   ' Set rotation in tenths of a degree, i.e., 1800 = 180 degrees
      
    '  lf.lfEscapement = 1800
    '  lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY
    '  hFont = CreateFontIndirect(lf)  'Create the rotated font
      
      '*******************************************************************
      'lfHeight As Integer
      'lfWidth As Integer
      'lfEscapement As Long
      'lfOrientation As Long
      'lfWeight As Long
      'lfItalic As Byte
      'lfUnderline As Byte
      'lfStrikeOut As Byte
      'lfCharSet As Byte
      'lfOutPrecision As Byte
      'lfClipPrecision As Byte
      'lfQuality As Byte
      'lfPitchAndFamily As Byte
      'lfFaceName As String * LF_FACESIZE
      '***************************************
      'int nHeight, // 所创建字体的字符高度
      'int nWidth, // 字体的字符平均宽度
'int nEscapement, // 字符输出方向与水平向右的方向所成角度，'
'以0.1度为单位
'int nOrientation, // 字符与基线的角度，以0.1度为单位
'int nWeight, // 字符颜色的深浅度
'BYTE bItalic, // 斜体属性标志(0:正常字体，非0:斜体)
'BYTE bUnderline, //下划线属性标志(0:无下划线，非0:有下划线)
'BYTE cStrikeOut,//删除线属性标志(0:无删除线，非0:有删除线)
'BYTE nCharSet, //字符集标识0:ANSI字符集，1:系统缺省字符集
'BYTE nOutPrecision, // 输出精度
'BYTE nClipPrecision, // 剪切精度
'BYTE nQuality, // 输出品质
'BYTE nPitchAndFamily, // 字符间距
'LPCTSTR lpszFacename // 现有系统TrueType字体名称''******************************创建字体*************************
     ' lf.lfEscapement = 1800
      lf.lfHeight = CInt(hsize * 22 / 17)
      lf.lfWidth = CInt(hsize * vsize * 2 / 3)
      lf.lfCharSet = 128
      lf.lfFaceName = Trim(Char_Type)
'*******************************创建结束************************            hFont = CreateFontIndirect(lf)
      
      di.cbSize = 20                  ' Size of DOCINFO structure
      di.lpszDocName = "My Document" ' Set name of print job (Optional)   ' Create a printer device context
      hPrintDc = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)      result = StartDoc(hPrintDc, di) 'Start a new print document
      result = StartPage(hPrintDc)    'Start a new page    ' Reset font back to original, non-rotated
      result = SelectObject(hPrintDc, hFont)
   
    ' Send non-rotated text to printer at same page location
      result = TextOut(hPrintDc, 600, 600, OutString, Len_String(OutString))      result = EndPage(hPrintDc)      'End the page
      result = EndDoc(hPrintDc)       'End the print job
      result = DeleteDC(hPrintDc)     'Delete the printer device context
      result = DeleteObject(hFont)    'Delete the font object   End Sub   Private Sub Form_Load()
      Command1.Caption = "API with Printer object"
      Command2.Caption = "Pure API"
   End Sub   Private Function Len_String(ByVal Str As String) As Long
      Dim I As Long
      Dim Num As Long
      If Str = "" Then
         Len_String = 0
      Else
         Num = 0
         For I = 1 To Len(Str)
            Num = Num + IIf(Asc(Mid(Str, I, 1)) < 0, 2, 1)
         Next
         Len_String = Num
      End If
   End Function
'*****************************************************
我用API打印时，发现无法创建字体:当将创建字体一段注释掉，打印正常；而加上该段时，则打印机光走纸，不打印。
请问这是为什么？