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

ir al índice