Mis utilidades:

Un procedimiento genérico para imprimir

Fecha: 3/Sep/97


Este procedimiento lo he hecho para usarlo en los casos en los que necesito hacer algún tipo de impresión de datos de forma sencilla, nada de virguerías ni cosas de esas.
Inicialmente la he esta usando para imprimir el contenido de un ListBox, el cual he usado como destino de los datos generados por una consulta de una base de datos. Este código lo habrás visto, espero, en los listados del Proyecto Paso a Paso (gsNotas).
Lo he modificado para que ahora soporte también un TextBox y entre otras curiosidades, tiene cómo usar el API de Windows para tomar la línea x de un textbox, cosa que antes hacía comprobando los cambios de línea y era un poco más lento y tedioso, con el uso del API, se hace directamente, he de decir que al probar distíntos métodos (mensajes de windows), se me ha "colgado" el sistema... pero fué por intentar usar un mensaje que realmente no es demasiado adaptable a VB, ya que usa unos parámetros que maneja las cadenas de caracteres al estilo "antiguo" y eso no va bien con el nuevo formato de cadenas de VB.
Pero al final lo hice usando otro método y según todas las pruebas realizadas funciona a la perfección.

Tengo que hacer una confesión: Este no es el código que inicialmente iba a poner. He quitado unas cosillas para intentar simplificar el tema y que la rutina sea lo más independiente posible. Si me da tiempo (son las 4.40 a.m.), pondré un ejemplo de cómo usarla, en el que incluiré un form genérico para solicitar la forma en que se imprimirán los datos.

Vamos ahora con la rutina y un poco de explicación: (aunque el código está bastante comentado)

La función del API SendMessage se usa, junto con los "mensajes":
EM_GETLINECOUNT: para saber la cantidad de líneas
EM_LINEINDEX: marca la línea especificada (empezando por cero), como línea actual
EM_LINELENGTH: devuelve el número de caracteres de la línea actual

Los parámetros que recibe, dos de ellos opcionales, son:
qControl: el control a procesar, será un ListBox o un TextBox (también valdría el RichTextBox)
vLPT: (opcional) es el puerto de impresora, sólo se tiene en cuenta si se imprime directamente, el valor predeterminado es LPT1
vDirecto: (opcional) Si es True, se imprime directamente. El valor por defecto es False: para usar el controlador de Windows

Por medio de un bucle, se imprime cada una de las líneas del control. En el caso del TextBox se puede imprimir todo de una vez. Pero uso el bucle para hacer un cambio de página en cada 60 líneas impresas. Aunque esto último sólo está "implementado" en el caso de impresión directa, es fácil de modificar a cuando se usa el controlador de Windows.
Si no sabes cómo adaptarlo, me preguntas y te lo explico.

Creo que lo mejor es ver el código y espero que te sea de utilidad.

Nos vemos.


El Código

#If Win32 Then
    'Declaración para 32 bits
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long

#Else
    'Declaración para 16 bits
    Declare Function SendMessage Lib "User" _
        (ByVal hWnd As Integer, ByVal wMsg As Integer, _
         ByVal wParam As Integer, lParam As Any) As Long

#End If
Public Sub gsImprimir(qControl As Control, Optional vLPT, Optional vDirecto)
    '--------------------------------------------------------------
    'Procedimiento genérico para imprimir               (31/Ago/97)
    '
    'Entrada:
    '   qControl    control a imprimir (TextBox, ListBox)
    '   vLPT        Impresora de salida, sólo para impresión directa
    '   vDirecto    Si se imprime directamente o se usa el controlador
    '--------------------------------------------------------------
    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 bDirecto As Boolean
    Dim tPrinter As Printer
    
    Dim L1&, L2&
    Const EM_GETLINECOUNT = &HBA
    Const EM_LINEINDEX = &HBB
    Const EM_LINELENGTH = &HC1
    
    Set tPrinter = Printer
    
    'El port de impresora a usar
    If IsMissing(vLPT) Then         'Si no se especifica,
        sLpt = "LPT1:"              'usar LPT1:
    Else
        sLpt = CStr(vLPT)
    End If
    'Si se va a imprimir directamente en el puerto
    'o se va a usar el controlador de Windows
    If IsMissing(vDirecto) Then     'Si no se especifica,
        bDirecto = False            'usar el controlador de Windows
    Else
        bDirecto = CBool(vDirecto)
    End If
    
    'Quitarle los dos puntos, si lo tiene,
    'seguramente no es necesario, pero...
    If Right$(sLpt, 1) = ":" Then
        sLpt = Left$(sLpt, Len(sLpt) - 1)
    End If
    
    If TypeOf qControl Is ListBox Then
        'Número de items en el listbox
        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
        'Abrir el puerto de impresora para salida...
        Open sLpt For Output As nFicSal
        Print #nFicSal, Chr$(15);   'Letra pequeña
    Else
        'Usar controlador de Windows
        tPrinter.Print ""
        tPrinter.Print ""
    End If
    'Se imprimirá cada una de las líneas del listbox o del textbox
    '-------------------------------------------------------------
    'En este último caso no sería necesario,
    'ya que se puede imprimir TODO de una vez, usando esto:
    'Printer.Print qControl.Text        'usando el controlador
    'Print #nFicSal, qControl.Text      'imprimiendo directamente
    '-------------------------------------------------------------
    For i = 0 To k - 1
        DoEvents
        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
        'Restaurar el tamaño de la fuente a normal
        Print #nFicSal, Chr$(18);
        'Si j vale CERO, ya se imprimió un salto de página
        'en caso contrario, echar la hoja fuera
        If j Then
            Print #nFicSal, Chr$(12);
        End If
        Close nFicSal
    Else
        tPrinter.EndDoc
    End If
End Sub

la Luna del Guille o... el Guille que está en la Luna... tanto monta...