Mis utilidades:

Ampliación del procedimiento genérico para imprimir

Fecha: 8/Sep/97

En esta ocasión la rutina se usa por medio de un interface... (que bien suena), lo que quiero decir es que se mostrará una ventana para seleccionar la impresora que se quiere usar y permite que se elija entre usar el controlador suministrado por Windows, con opción extra de usar el tipo de fuente Courier New de 8 puntos (lo he pensado para mostrar listados), además de poder imprimir directamente a la impresora (en modo texto).

En el código hay una serie de variables que las uso de forma genérica para la rutina de búsqueda y otros menesteres, en el listado de ejemplo, se acompañan todos los archivos (módulos y forms) necesarios para poder usar esta utilidad.

 

Este es el aspecto del form:

Y este es el código que he usado.
Primero el del procedimiento gsImprimir, que es el que se encarga de que se muestre este form:
Éste código es casi clavado al que ya mostré anteriormente, pero esta rutina no necesita parámetros extras, ya que las distintas opciones de impresión se toman del form de Imprimir Datos, (en el archivo comprimido con el ejemplo, se acompaña también el otro código pero con el nombre gsImprimir1)
Recuerda que también permite imprimir el contenido de un ListBox.

'------------------------------------------------------------------
'Módulo con función genérica para imprimir              (31/Ago/97)
'
'(c)Guillermo Som, 1997
'------------------------------------------------------------------
Option Explicit


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 L1&, L2&
    Const EM_GETLINECOUNT = &HBA
    Const EM_LINEINDEX = &HBB
    Const EM_LINELENGTH = &HC1
    

    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
            'Dim tPrinter2 As Printer
            'For Each tPrinter2 In Printers
            '    If tPrinter2.DeviceName = .CboImpresoras.Text Then
            '        Set Printer = tPrinter2
            '        Exit For
            '    End If
            'Next
            Set tPrinter = Printer
        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 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
End Sub

Ahora el código del Form de Imprimir:

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


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()
    'Mostrar todas las impresoras instaladas
    '
    Dim tPrinter As Printer
    Dim i As Integer
    
    bCambiandoCombo = True
    CboImpresoras.Clear
    i = 0
    For Each tPrinter In Printers
        CboImpresoras.AddItem tPrinter.DeviceName
        i = i + 1
        If tPrinter.DeviceName = Printer.DeviceName Then
            ImpresoraActual = i
        End If
    Next
    CboImpresoras.ListIndex = ImpresoraActual - 1
    bCambiandoCombo = False
    MostrarPortImpresora
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

En el programa de ejemplo, se incluye también un Mini-Editor y un form para un diálogo de Buscar/Reemplazar, así como otras rutinas y funciones para leer y escribir en un archivo .INI.

Espero que lo disfrutes y si tienes algún comentario que hacerme, pincha aquí.

Nos vemos.