Imprimir un Grid e Imprimir un TextBox
Dos colaboraciones de Héctor Agea
HAM [email protected]
Actualizado 27-Abr-97
Espero que os sea de utilidad y para que HAM no vea que tengo nada contra él, aquí pongo también la primera y "controvertida" colaboración (la de imprimir un GRID) Esta rutina está modificada de una publicada por Microsoft en las KB.
Imprimir un TextBox
(Incluyo los comentarios del mensaje que he recibido, para que todo quede claro y se note la buena voluntad de la gente, hay que colaborar y "mejorar" lo que se ve por esos "sitios" de Dios, que para eso estamos y sobre todo "compartir" lo que tenemos y hemos recolectado por ahí)
Consiste en imprimir un text box multiline, en la posición que se quiera de pantalla y además si tiene alineamiento, lo alinea. Una parte la he sacado de un sample de VB 4.0 (lo puedes comprobar si tú quieres, es el vbmail.vpp) pero yo lo he reecho entero. Decide tú mismo si he plagiado o no. Texto original: (la parte que interesa, claro) --------------- Sub PrintLongText(ByVal LongText As String) Do Until LongText = "" Word$ = Token$(LongText, " ") If Printer.TextWidth(Word$) + Printer.CurrentX > Printer.Width - Printer.TextWidth("ZZZZZZZZ") Then Printer.Print End If Printer.Print " " + Word$; Loop End Sub Function Token$(tmp$, search$) X = InStr(1, tmp$, search$) If X Then Token$ = Mid$(tmp$, 1, X - 1) tmp$ = Mid$(tmp$, X + 1) Else Token$ = tmp$ tmp$ = "" End If End Function Texto final: (El que yo he hecho) ------------ Sub DibujarCelda(Dos As Object, Caja As TextBox) Dim Word As String Dim mensage As String Dim anchura As Integer Dim resultado As String Dim tmp As String tmp = "" ' Inicializo variables resultado = "" Dos.Show Dos.FontBold = Caja.FontBold ' Copio las propiedades de la TB Dos.FontItalic = Caja.FontItalic Dos.FontName = Caja.FontName Dos.FontSize = Caja.FontSize Dos.CurrentY = Caja.Top + 25 ' Posiciono mensage = Caja.Text anchura = Caja.Width - Dos.TextWidth("") - 3 * Dos.DrawWidth * Screen.TwipsPerPixelX Do While mensage <> "" Word = Token(mensage, " ") ' Cojo hasta el primer espacio ' Si la longitud del texto es mayor que la anchura de la caja ' entonces se imprime el primer caracter If Dos.TextWidth(Word) > anchura Then mensage = Word & mensage Word = TokenWidth(mensage, anchura, Dos) End If ' Si la anchura de la linea actualmente ya es mayor que la de la ' caja, imprimir un retorno de carro If Dos.TextWidth(Word) + Dos.TextWidth(tmp) > anchura Then resultado = resultado & tmp & Chr(13) tmp = "" End If ' Si la siguiente linea se pasa del cuadrado acabar If (Dos.TextHeight(resultado) > Caja.Height) Then Exit Do End If tmp = tmp & Word & " " Loop If (mensage = "") Then resultado = resultado & tmp & Chr(13) tmp = "" End If Do While resultado <> "" Word = Token(resultado, Chr(13)) Select Case Caja.Alignment Case 0 ' Izquierda Dos.CurrentX = Caja.Left + 2 * Dos.DrawWidth * Screen.TwipsPerPixelX Case 1 ' Derecha Dos.CurrentX = Caja.Left + Caja.Width - Dos.TextWidth(Word) - _ 2 * Dos.DrawWidth * Screen.TwipsPerPixelX Case 2 ' Centro Dos.CurrentX = Caja.Left + Caja.Width / 2 - Dos.TextWidth(Word) / 2 End Select Dos.Print Word Loop End Sub Function Token(tmp As String, search As String) As String x = InStr(1, tmp, search) If x Then Token = Mid$(tmp, 1, x - 1) tmp = Mid$(tmp, x + 1) Else Token = tmp tmp = "" End If End Function Function TokenWidth(tmp As String, longitud As Integer, Donde As Object) As String While (Donde.TextWidth(TokenWidth) < longitud) And tmp <> "" TokenWidth = TokenWidth & Mid$(tmp, 1, 1) tmp = Mid$(tmp, 2) Wend tmp = Mid$(TokenWidth, Len(TokenWidth), 1) & tmp TokenWidth = Mid$(TokenWidth, 1, Len(TokenWidth) - 1) End Function Como puedes ver se parecen, más bien poco, por no decir nada. Habrás observado que lo único que conservo es el procedimiento Token, todo lo demás es nuevo. Es fácil de utilizar, si quieres te mando un ejemplo pero no creo que haga falta. Si decides que los cambios son substanciales, mejoran el producto y hacen de él uno mejor, con mayores prestaciones entonces, por definición, yo soy el autor (inspirado en lo otro, pero el autor). Yo creo que es bueno, y si decides ponerlo en la página, me sigue haciendo ilusión que pongas lo de: HAM [email protected], y que pongas que es "mejoraware", o sea que si lo utilizan que me manden una mejora en el código (reconozco que no es perfecto). Bueno, a ver que me dices.
Imprimir un Grid
(Esta es la rutina "controvertida", pero aquí la pongo para el disfrute y uso de quién lo necesite. Gracias HAM)
Creo que es bastante claro, a mi me funciona así, si encontrais algún fallo decidmelo por favor que lo corregiré (si me lo dais corregido, mejor :-) ) Una pequeña contribución tal como os había prometido. Os pido un favor, si lo incluís a vuestra página incluid mi nombre y mail, algo del estilo de: HAM, [email protected] Me hace ilusión verme en una página y así a lo mejor alguien me dice más cosas de los grids. Pasos a seguir para imprimir un grid ------------------------------------- 1. Crear un grid y meterlo en el Form1, metiendole (por ejemplo) 6 filas y columnas. 2. Añadir el siguinete código al evento Form1 Click: Sub Form_Click () Dim i, j For i = 0 To Grid1.Cols - 1 For j = 0 To Grid1.Rows - 1 Grid1.Col = i Grid1.Row = j Grid1.Text = Format$(i + j + i ^ j) Next Next Call Grid_Print(Grid1) Printer.EndDoc End Sub 2. Añadir el siguiente código a la sección de declaraciones globales: Sub Grid_Print (grid As Control) Dim tppx As Integer Dim tppy As Integer tppx = Printer.TwipsPerPixelX tppy = Printer.TwipsPerPixelY Dim Col As Integer Dim Row As Integer Dim x0 As Single Dim y0 As Single Dim x1 As Single Dim y1 As Single Dim x2 As Single Dim y2 As Single x0 = Printer.CurrentX y0 = Printer.CurrentY If grid.BorderStyle <> 0 Then Printer.Line -Step(grid.Width - tppx, grid.Height - tppy), , B x0 = x0 + tppx y0 = y0 + tppy End If x1 = x0 For Col = 0 To grid.Cols - 1 If Col >= grid.FixedCols And Col < grid.LeftCol Then Col = grid.LeftCol End If If x1 + grid.ColWidth(Col) >= grid.Width Then Exit For y1 = y0 For Row = 0 To grid.Rows - 1 If Row >= grid.FixedRows And Row < grid.TopRow Then Row = grid.TopRow End If If y1 + grid.RowHeight(Row) >= grid.Height Then Exit For Printer.CurrentX = x1 + tppx * 2 Printer.CurrentY = y1 + tppy grid.Col = Col grid.Row = Row Printer.Print grid.Text y1 = y1 + grid.RowHeight(Row) If grid.GridLines Then y1 = y1 + tppy End If Next x1 = x1 + grid.ColWidth(Col) If grid.GridLines Then x1 = x1 + tppx End If Next If grid.GridLines Then x2 = x0 y2 = y0 For Col = 0 To grid.Cols - 1 If Col >= grid.FixedCols And Col < grid.LeftCol Then Col = grid.LeftCol End If x2 = x2 + grid.ColWidth(Col) If x2 >= grid.Width Then Exit For Printer.Line (x2, y0)-Step(0, y1 - tppy) x2 = x2 + tppx Next For Row = 0 To grid.Rows - 1 If Row >= grid.FixedRows And Row < grid.TopRow Then Row = grid.TopRow End If y2 = y2 + grid.RowHeight(Row) If y2 >= grid.Height Then Exit For Printer.Line (x0, y2)-Step(x1 - tppx, 0) y2 = y2 + tppy Next End If End Sub 3. Ejecutarlo