Mis utilidades:

Revisión y más ampliación del
procedimiento genérico para imprimir

Fecha: 11/Sep/97
Actualizado el código: 05/May/2006

Si quieres ver la página anterior con todo el listado, pulsa en este link

En vista de que el Service Pack 2 para VB5 ha solucionado el problemilla de las impresoras, he añadido al form de selección de impresora el que se pueda indicar la orientación del papel, esto ya funcionaba en el VB4, así que puedes adaptar el código que ofrecí anteriormente para el VB4, ya que el que está en el archivo de ejemplo es para VB5...

No me voy a enrollar demasiado y te mostraré el nuevo aspecto del form en cuestión, así como el código del form de imprimir y la rutina que maneja este form y se encarga de la impresión.

¡¡¡Que lo disfrutes!!!

 

Este es el nuevo aspecto del form de selección de impresora y demás cosas:

Este es el código del form de Imprimir con lo que había y lo que ha cambiado:

'Diálogo para imprimir los datos...     ( 9/Oct/96)
'Adaptado/simplificado para Imprimir normal             ( 1/Sep/97)
'
Option Explicit
'
Dim bCambiandoCombo As Boolean
Dim ImpresoraActual As Integer
'
Dim tOrientacion As Integer         '(10/Sep/97)

Public sLpt As String


Private Sub cboImpresoras_Click()
    Dim tPrinter As Printer
    
    If bCambiandoCombo Then Exit Sub
    
    For Each tPrinter In Printers
        If tPrinter.DeviceName = CboImpresoras.Text Then
            Set Printer = tPrinter
            Exit For
        End If
    Next
    MostrarPortImpresora
End Sub


Private Sub CmdCancelar_Click()
    iFFAccion = cFFAc_Cancelar
    Unload Me
End Sub


'Private Sub CmdAceptar_Click()
'    iFFAccion = cFFAc_Aceptar
'    Hide
'End Sub

' Modificación para comprobar si hay impresoras instaladas (05/May/06)
' Modificación aportada por: · \/\/·a·(r)·£·ø·¢·K ·
Private Sub CmdAceptar_Click()
    If CboImpresoras.ListCount <> 0 Then
        iFFAccion = cFFAc_Aceptar
        Hide
    Else
        MsgBox "No hay Impresoras Instaladas", vbOKOnly, "ERROR"
    End If
End Sub


Private Sub chkOrientacion_Click()
    Dim i As Integer
    
    For i = 0 To 1
        optOrientacion(i).Enabled = chkOrientacion
    Next
End Sub


Private Sub Form_Load()
    Dim e1 As Boolean
    
    iFFAccion = cFFAc_IDLE
    DoEvents
    '
    'Centrar el form
    Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
    '
    If OptMétodoImpresión(0) = 1 Then
        e1 = True
    Else
        e1 = False
    End If
    chkCourierNew.Enabled = e1
    '
    MostrarImpresoras
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode <> vbFormCode Then
        iFFAccion = cFFAc_Cancelar
    End If
End Sub


Private Sub MostrarPortImpresora()
    
    On Local Error Resume Next
    
    sLpt = Printer.Port
    If Right$(sLpt, 1) = ":" Then
        sLpt = Left$(sLpt, Len(sLpt) - 1)
    End If
    '
    Label3 = "Los datos se imprimirán en: " & sLpt
    On Local Error GoTo 0
End Sub


Private Sub MostrarImpresoras()
    On Local Error Resume Next
    
    'Mostrar todas las impresoras instaladas
    '
    Dim tPrinter As Printer
    Dim i As Integer
    
    
    bCambiandoCombo = True
    tOrientacion = 0
    
    CboImpresoras.Clear
    i = 0
    For Each tPrinter In Printers
        CboImpresoras.AddItem tPrinter.DeviceName
        i = i + 1
        If tPrinter.DeviceName = Printer.DeviceName Then
            ImpresoraActual = i
            tOrientacion = tPrinter.Orientation
        End If
    Next
    CboImpresoras.ListIndex = ImpresoraActual - 1
    If tOrientacion Then
        optOrientacion(tOrientacion - 1) = True
    End If
    bCambiandoCombo = False
    MostrarPortImpresora
    
    Err = 0
    On Local Error GoTo 0
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set Imprimir = Nothing
End Sub


Private Sub OptMétodoImpresión_Click(Index As Integer)
    Dim e1 As Boolean
    Static YaEstoy As Boolean
    
    If YaEstoy Then Exit Sub
    
    YaEstoy = True
    If OptMétodoImpresión(0) Then
        e1 = True
    Else
        e1 = False
    End If
    chkCourierNew.Enabled = e1
    YaEstoy = False
End Sub


Private Sub optOrientacion_Click(Index As Integer)
    tOrientacion = Index + 1
End Sub

Así quedaría el procedimiento genérico de imprimir:

Public Sub gsImprimir(qControl As Control)
    '--------------------------------------------------------------
    'Procedimiento genérico para imprimir               (31/Ago/97)
    '
    'Entrada:
    '   qControl    control a imprimir (TextBox, ListBox)
    '
    '--------------------------------------------------------------
    Const MAXLINEA = 136        'Número de caracteres máximos por línea
    
    Dim nFicSal As Integer
    Dim sLpt As String
    Dim i As Long
    Dim j As Integer
    Dim k As Long
    Dim sTmp As String
    Dim sImpresora As String
    Dim sngFS As Single
    Dim sFN As String
    Dim bDirecto As Boolean
    Dim bCourierNew As Boolean
    Dim tPrinter As Printer
    Dim tOrientacion As Integer
    Dim tOrientacionAnt As Integer
    
    Dim L1&, L2&
    Const EM_GETLINECOUNT = &HBA
    Const EM_LINEINDEX = &HBB
    Const EM_LINELENGTH = &HC1
    
    'On Local Error Resume Next 'GoTo ErrorImprimiendo

    Set tPrinter = Printer
    
    'Seleccionar impresora
    Dim frmImpresora As Form
    '
    iFFAccion = cFFAc_IDLE
    '
    
    'Cargar la ventana de selección de impresora
    Set frmImpresora = New Imprimir
    With frmImpresora
        'Mostrar el Form
        'Controlador de Windows
        .OptMétodoImpresión(0) = 1
        .chkCourierNew.Enabled = True
        'Imprimir directamente
        .OptMétodoImpresión(1) = 0
        .Show vbModal
        If iFFAccion <> cFFAc_Cancelar Then
            sLpt = .sLpt
            If Right$(sLpt, 1) <> ":" Then
                sLpt = sLpt & ":"
            End If
            bDirecto = .OptMétodoImpresión(1)
            bCourierNew = .chkCourierNew
            'Seleccionar la impresora como predeterminada
            Set tPrinter = Printer
            If .chkOrientacion Then
                tOrientacionAnt = tPrinter.Orientation
                If .optOrientacion(0) Then
                    tOrientacion = vbPRORPortrait
                Else
                    tOrientacion = vbPRORLandscape
                End If
                tPrinter.Orientation = tOrientacion
            End If
        End If
    End With
    Unload frmImpresora
    Set frmImpresora = Nothing
    If iFFAccion = cFFAc_Cancelar Then Exit Sub
    If Right$(sLpt, 1) = ":" Then
        sLpt = Left$(sLpt, Len(sLpt) - 1)
    End If
    
    If TypeOf qControl Is ListBox Then
        k = qControl.ListCount
    Else
        'Número de líneas del TextBox
        k = SendMessage(qControl.hWnd, EM_GETLINECOUNT, 0, 0&)
    End If
    If bDirecto Then
        'Imprimir directamente...
        j = 0
        nFicSal = FreeFile
        Open sLpt For Output As nFicSal
        Print #nFicSal, Chr$(15);   'Letra pequeña
    Else
        'Usar controlador de Windows
        sngFS = tPrinter.FontSize
        sFN = tPrinter.FontName
        'If MsgBox("¿Quieres Imprimir con Courier New 8 puntos?", 4 + 32, "Imprimir") = 6 Then
        If bCourierNew Then
            tPrinter.FontSize = 8
            tPrinter.FontName = "Courier New"
        End If
        If Err Then Err = 0
        tPrinter.Print ""
        tPrinter.Print ""
    End If
    For i = 0 To k - 1
        DoEvents
        If iFFAccion = cFFAc_Cancelar Then Exit For
        'Caption = "Imprimiendo " & i + 1 & " de " & k
        If TypeOf qControl Is ListBox Then
            If bDirecto Then
                Print #nFicSal, Left$(qControl.List(i), MAXLINEA)
            Else
                tPrinter.Print Left$(qControl.List(i), MAXLINEA)
            End If
        Else
            'Primer carácter de la línea actual
            L1 = SendMessage(qControl.hWnd, EM_LINEINDEX, i, 0&) + 1
            'Longitud de la línea actual
            L2 = SendMessage(qControl.hWnd, EM_LINELENGTH, L1, 0&)
            If L2 > MAXLINEA Then L2 = MAXLINEA
            If bDirecto Then
                Print #nFicSal, Mid$(qControl.Text, L1, L2)
                j = j + 1
                'cada 60 líneas en una página
                If j = 60 Then
                    Print #nFicSal, Chr$(12);
                    j = 0
                End If
            Else
                tPrinter.Print Mid$(qControl.Text, L1, L2)
            End If
        End If
    Next
    If bDirecto Then
        If j Then
            Print #nFicSal, Chr$(12);
        End If
        Print #nFicSal, Chr$(18);
        Close nFicSal
    Else
        tPrinter.EndDoc
        'restaurar la fuente anterior
        tPrinter.FontSize = sngFS
        tPrinter.FontName = sFN
    End If
    'Restaurar la orientación anterior del papel
    If tOrientacionAnt Then
        tPrinter.Orientation = tOrientacionAnt
    End If
End Sub

 

Bajate los listados y el ejemplo para VB5 (t_imprimir2.zip 20.1 KB)
El nuevo form se llama: Imprimir2.frm, pero se adjunta también el antiguo.