Resumen Imprimir grids   (2 mensajes )

Ale, venga, que nadie se va a mojar el culo.
Me parece que a nadie le gusta imprimir, porque nadie contesta este tipo
de mails, ¿qué narices haceis con los datos? ¿coleccionarlos?, si vais
entrando pero nunca los sacais...
Este código es para aquellos que estamos intentando imprimir, si le
encontrais fallos (que no dudo que tenga, aunque a mi me vaya bien)
decidmelos y ya puestos me los podrías hasta corregir, puestos a pedir
:-)
Eduardo de la Torre y Antonie E. López, decidme que tal os va y los
problemas que encontrais y lo dicho si los podeis corregir...


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

-------------------
Hèctor Agea Merino
Barcelona - Espanna
agea@hotmail.com
-------------------

X-Mailreader: GoldED/386 2.51.A1026+
Sender: llander@pobox.com (Guillermo Llanderas)
X-UIDL: fa419af7b8024d54ec1df36a19655b4d

¡Hola, Jose!

    Aquí tienes las rutinas. :)

> ---------8<---------8<--------- CORTAR ---------8<---------8<---------

Option Explicit ' - Ian Patton, 1994-96 - ipatton@indigo.ie

'Here is a simple routine I have devised which for me
'simplifies the printing of the contents of a TruegGrid to the
'printer. There are also two Grid Copy routines: one for the
'standard VB Grid control and one for TrueGrid. They are all
'independent of column or row numbers so should work straight off.

'These routines were dsigned and used in VB 3. They may work in
'VB 4 but I have'nt tried them yet.

'The copy routines produce Tab Separated text which can then be
'pasted into any word processor and formatted as required. proper
'alignment of columns in your word processor may require a change
'of font or the addition of some Tabs to help balance a column.

'The print routine formats text as it finds it in TrueGrid, ie:
'Left/Centre/Right aligned as appropriate. I have had to set the
'print body text to Courier so that Right Alignment would work
'properly. Proportionally spaced fonts like Arial & Times produce
'a ragged right margin. If anyone knows how to overcome this, I
'would welcome your advice.

'You are FREE to use the enclosed as is, or to modify it to suit
'your needs as required. It is Free. All I would ask is that:

' (a) You do not re-submit the enclosed on any bullitin board,
' or through any internet service provider as your own work
' or, if included as part of a larger submission, you leave
' the copyright/eMail flag at the start of each routine.

' (b) If you use this in your own programs, again leave the
' copyright/eMail flag at the start of each routine, just
' to remember me !

' (c) Any chance of giving me feedback, just to say if you
' found it any use (or not!) and if so, were you able
' to use any of it

'Any comments, criticisms etc would be welcome. Choose which form
'of adress best suits you, from below. Good luc :-)

'Compuserve: 100024,1606
'Internet: ipatton@indigo.ie

'Usual disclaimer. The enclosed works for me but I can't guarantee
'that it will work for You. Use at your own risk. By accepting and
'using the enclosed, you agree that I have no responsibility for
'any loss, direct or consequential, as a result of your use.


'Ian Patton

Sub Copy_Grid () ' - Ian Patton, 1994-96 - ipatton@indigo.ie

    'Generic sub for clipboard copy from standard GRID.VBX

    Dim CopyText As String, NC As String, NR As String
    Dim First_Col As Integer, First_Row As Integer

    'GridName = your grid. replace as required

    Screen.MousePointer = 11
    Clipboard.Clear 'not really necessary (but safe)

    NC = Chr$(9) 'Tab Character
    NR = Chr$(13) & Chr$(10) 'Carriage Return & Linefeed

    First_Col = GridName.Fixedcols 'Set counter for first column
    First_Row = GridName.FixedRows 'Set counter for first row

    For i% = First_Row To GridName.Rows - 1
    GridName.Row = i%
    For j% = 0 + First_Col To GridName.Cols - 1
        GridName.Col = j%
        If j% = First_Col Then
      CopyText = CopyText & GridName.text
        Else
      CopyText = CopyText & NC & GridName.text
        End If
    Next
    CopyText = CopyText & NR
    Next

    Clipboard.SetText CopyText
    Screen.MousePointer = 0

End Sub

Sub Copy_TrueGrid () ' - Ian Patton, 1994-96 - ipatton@indigo.ie

    'Generic sub for clipboard copy from TrueGrid

    Dim CopyText, TC, CRL As String, r As Integer, c As integr
    Dim First_Col, First_Row As Integer

    'MyTrueGrid = your grid. replace as required

    Screen.MousePointer = 11 'show Hourglass, copy could take a while
    MyTrueGrid.Active = False 'Stop TrueGrid "flashing"
    Clipboard.Clear 'not really necessary (but safe)

    CopyText = ""
    TC = Chr$(9) 'Tab character
    CRL = Chr$(13) & Chr$(10) 'Carriage Return & Linefeed

    First_Col = 1 'Set counter for first column
    First_Row = 1 'Set counter for first row

    MyTrueGrid.TopRow = 1 'Position to first row
    MyTrueGrid.LeftColumn = 1 'Position to first column

    For r = First_Row To RowCount
    MyTrueGrid.RowIndex = r
    For c = First_Col To RateTable.Columns - 1
        MyTrueGrid.ColumnIndex = c
        If MyTrueGrid.ColumnVisible(c) = True Then
      If c = First_Col Then
          CopyText = CopyText & MyTrueGrid.text
      Else
          CopyText = CopyText & TC & MyTrueGrid.text
      End If
        End If
    Next
    CopyText = CopyText & CRL
    Next

    Clipboard.SetText CopyText 'Send copied table to clipboard

    Screen.MousePointer = 0 'Return cursor to default
    MyTrueGrid.RowIndex = 1 'Re-position to first column
    MyTrueGrid.ColumnIndex = 1 'Re-Position to first column
    MyTrueGrid.Active = True 'Reinstate TrueGrid

End Sub

Sub Print_MyTrueGrid () ' - Ian Patton, 1994-96 - ipatton@indigo.ie

    'Generic print sub for MyTrueGrid tables
    Dim ColStyle, ColWide, TabNow, TabPos, LineCount As Integer
    Dim RptName, RptSub, ColText, PageFoot As String
    Dim r As Integer, n As Integer, c As Integer

    'MyTrueGrid = your grid. replace as required

    Screen.MousePointer = 11 'show Hourglass, print could take a while
    Printer.ScaleMode = 4 'characters

    'Assign text to String Variables
    RptName = "Anything Title you like" 'can be a variable if preferred
    RptSub = "Anything Subtitle you like" 'can be a variable if preferred
    PageFoot = "Page: "
    LineCount = 0

    'Set display and position to 1st row / 1st column
    MyTrueGrid.TopRow = 1: MyTrueGrid.RowIndex = 1
    MyTrueGrid.LeftColumn = 1: MyTrueGrid.ColumnIndex = 1

    For r = 1 To RowCount
    'Header info ---------------------------------------
    LineCount = LineCount + 1
    If LineCount = 1 Then
        TabPos = 2
        Printer.FontName = "Arial"
        Printer.FontSize = 14: Printer.FontBold = True
        Printer.Print
        Printer.Print Tab(TabPos); RptName
        Printer.Print 'Blank line
        Printer.FontName = "Arial"
        Printer.FontSize = 10: Printer.FontBold = False
        Printer.Print 'Blank line
        Printer.Print Tab(TabPos); RptSub
        Printer.Print 'Blank line

        'Table Column names ----------------------------
        Printer.FontName = "Courier New"
        Printer.FontSize = 9: Printer.FontBold = False
        For n = 1 To MyTrueGrid.Columns
      If MyTrueGrid.ColumnVisible(n) = True Then
          'Calculation for Tab() positions
          ColWide = MyTrueGrid.ColumnWidth(n)
          ColText = MyTrueGrid.ColumnName(n)
          ColStyle = MyTrueGrid.ColumnStyle(n)
          'Check your table for col types and change Case as approprate
          Select Case ColStyle
       Case 8192 'Left-align/Read only
           TabNow = TabPos
       Case 8193 'Centre/Read only
           TabNow = (TabPos + ColWide \ 2) - (Len(ColText) \ 2)
       Case 8194 'Right-align/Read only
           TabNow = (TabPos + ColWide) - Len(ColText)
          End Select
          Printer.Print Tab(TabNow); ColText;
          TabPos = TabPos + ColWide + 2
      End If
        Next n
        Printer.Print 'forces CR/LF at end of Row
    End If

    'Body Info -----------------------------------------
    TabPos = 2
    MyTrueGrid.RowIndex = r
    For c = 1 To MyTrueGrid.Columns
        MyTrueGrid.ColumnIndex = c
        If MyTrueGrid.ColumnVisible(c) = True Then
      'Calculation for Tab() positions
      ColWide = MyTrueGrid.ColumnWidth(c)
      ColText = MyTrueGrid.text 'Table.ColumnText() = unformatted
      ColStyle = MyTrueGrid.ColumnStyle(c)
      Select Case ColStyle
          Case 8192 'Left-align/Read only
       TabNow = TabPos
          Case 8193 'Centre/Read only
       TabNow = (TabPos + ColWide \ 2) - (Len(ColText) \ 2)
          Case 8194 'Right-align/Read only
       TabNow = (TabPos + ColWide) - Len(ColText)
      End Select
      Printer.Print Tab(TabNow); ColText;
      TabPos = TabPos + ColWide + 2
        End If
    Next
    Printer.Print 'forces CR/LF at end of Row

    'Footer Info ---------------------------------------
    If LineCount = 42 Then
        Printer.Print 'Blank line
        TabPos = (Printer.ScaleWidth \ 2) - (Len(PageFoot) \ 2)
        Printer.Print Tab(TabPos); PageFoot; Printer.Page
        Printer.NewPage : LineCount = 0
        DoEvents 'allow Windows access at end of every page
    End If
    Next

    'Reset display and position to 1st row / 1st column
    MyTrueGrid.TopRow = 1: MyTrueGrid.RowIndex = 1
    MyTrueGrid.LeftColumn = 1: MyTrueGrid.ColumnIndex = 1
    DoEvents

    'print page footer on last/short page ------------------
    If Not LineCount = 42 Then
    Do Until LineCount = 42
        Printer.Print 'Blank line
        LineCount = LineCount + 1
    Loop
    Printer.Print 'Blank line
    TabPos = (Printer.ScaleWidth \ 2) - (Len(PageFoot) \ 2)
    Printer.Print Tab(TabPos); PageFoot; Printer.Page
    LineCount = 0
    End If
' NewPage / Endoc ensures no blank page before ending print
    Printer.NewPage : Printer.EndDoc
    Screen.MousePointer = 0 'Return cursor to default

End Sub

> ---------8<---------8<--------- CORTAR ---------8<---------8<---------

Saludos.............. GLL



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com