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 actualLos 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 WindowsPor 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 IfPublic 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