Imprimir un Grid e Imprimir un TextBox
Dos colaboraciones de Héctor Agea
HAM agea@hotmail.com
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 agea@hotmail.com,
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, agea@hotmail.com
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
