El código está comentado y permite ver cómo realizar impresiones con Gambas3 (Que no es nada fácil ). Se puede adaptar fácilmente a otras necesidades de impresión.
También muestra un bug de la impresión con este sistema .No funciona cuando se selecciona impresión en landscape.
Si alguien entiende que no es un bug sino que yo estoy haciéndolo mal agradeceré una corrección .
Aquí está. Espero que sea útil a mucha gente.
' gambas class file
' *********************************************************************************************
' Esta clase dispone lo necesario para crear un listado a partir de un resultado
' ************************************************************************************************
Private iPages As Integer
Private iYPos As Integer
Private RMargin As Integer
Private LMargin As Integer
Private TMargin As Integer
Private BMargin As Integer
Private resDatos As Result
Private PrinterName As String
Private pPrinter As Printer
Private FontName As String
Private pFont As Font
Private bolPDF As Boolean
Private iOrientation As Integer
Private sTitulo As String
Private fLineHeight As Float
Private fTitleHeight As Float
Private fTitleFontSize As Float
Private fLineFontSize As Float
Public Struct FieldPrint
'Esta estructura determina las características de un campo en la impresión
Name As String
X As Integer
Width As Integer
Align As Integer
End Struct
Public Struct Page
'Esta estructura determina la estructura de una página
sFields As FieldPrint[]
lFirstRecord As Long
lLastRecord As Long
End Struct
Private Pages As Page[] 'Almacenará las estructuras de todas las páginas que intervienen en el listado
Public Sub _new(res As Result, titulo As String, Optional sPrinter As String = "", Optional sFont As String = "Serif", Optional fFontSize As Integer = 3.5, Optional orientation As Integer = 0, Optional generarPDF As Boolean = False)
resDatos = res
bolPDF = generarPDF
'*******************************************************
iOrientation = orientation 'Esto no funciona
'*******************************************************
sTitulo = titulo
fTitleFontSize = fFontSize * 1.5
fLineFontSize = fFontSize
PrinterName = sPrinter
FontName = sFont
End
Public Sub Imprimir()
pPrinter = New Printer As "FPrinter"
If bolPDF Then
pPrinter.Name = "Imprimir a un archivo"
Dialog.Title = "Archivo destino"
Dialog.Path = "/tmp/" & sTitulo
Dialog.Filter = ["*.pdf", "Formato de documento portable"]
Dialog.AutoExt = True
Dialog.SaveFile
pPrinter.OutputFile = Dialog.Path
Else
If Not PrinterName Then
If pPrinter.Configure() Then Return
Endif
Endif
'Para calcular las posiciones de impresión de cada elemento lo hacemos sobre el área completa de la página y no sobre la
'parte efectivamente imprimible
pPrinter.FullPage = True
Inc Application.Busy
'Esto no funciona cuando la orientación es 1 - Landscape
'Lo mismo sucederá si se abre el diálogo de configuración de impresoras y se selecciona landscape en este
''*********************************************
'pPrinter.Orientation = iOrientation
'**********************************************
pPrinter.print 'Dispara el evento Printer_Begin()
Dec Application.Busy
Catch
Message.Error("Error " & Error.Code & " " & Error.Text, "Aceptar")
End
Public Sub FPrinter_Begin()
'La impresión se hace mediante Paint así que establecemos las medidas de Paint a las de nuestra página
Paint.Scale((Paint.Width) / pPrinter.PaperWidth, (Paint.Height) / pPrinter.PaperHeight) 'Cooordenadas en milímetros
pfont = New Font(FontName)
LMargin = 12
RMargin = pPrinter.PaperWidth - LMargin
TMargin = 10
BMargin = pPrinter.PaperHeight - 15
'Aquí tenemos dos opciones que son:
'1 - Indicar el número de páginas a imprimir si podemos conocerlo por ser un listado simple
'pPrinter.Count = iPages
'2 - comentar la línea anterior y utilizar el evento Paginate para calcular el número de páginas a imprimir.
'El evento paginate se dispara si dentro del evento Begin en que estamos no se asigna ninguna cantidad a Count
End
Public Sub FPrinter_Paginate()
Dim fld As ResultField, curFieldPrint As FieldPrint, intRecordsPerPage As Integer, curPage As Page, iColPages As Integer
Dim cp As Integer, rp As Integer, iRowPages As Integer
Debug "Paginando"
'Determinando la altura de la línea de título
pFont.Size = fTitleFontSize
fTitleHeight = pFont.TextHeight("H")
'determinando la altura de la línea de texto
pFont.Size = fLineFontSize
fLineHeight = pFont.TextHeight("H")
'Creando las definiciones de páginas
Pages = New Page[]
curPage = New Page
iRowPages = 1 'iRowPages contendrá el número de páginas que ocupa cada fila de datos teniendo en cuenta el tamaño
'de la impresión
curPage.sFields = New FieldPrint[]
pFont.Size = fLineFontSize
'El número de registros que cabrán por página se calcula restando del margen inferior el margen superior, el alto del título,
'el alto de los títulos de columnnas 1 líneas y 1.5 líneas para el número de página
intRecordsPerPage = (BMargin - TMargin - fTitleHeight - fLineHeight - fLineHeight * 1.5) / fLineHeight
For Each fld In resDatos.Fields
curFieldPrint = New FieldPrint
Select Case fld.Type
Case gb.Boolean
curFieldPrint.Width = pFont.TextWidth("T")
curFieldPrint.Align = 3
Case gb.Integer
curFieldPrint.Width = pFont.TextWidth("12345")
curFieldPrint.Align = 2
Case GB.Long
curFieldPrint.Width = pFont.TextWidth("1234567")
curFieldPrint.Align = 2
Case gb.Float
curFieldPrint.Width = pFont.TextWidth("12345,12")
curFieldPrint.Align = 2
Case gb.Date
curFieldPrint.Width = pFont.TextWidth("01/01/0000")
curFieldPrint.Align = 3
Case gb.String
If (fld.Length / 3) > 20 Then 'Length devuelve tres veces la longitud de la cadena
curFieldPrint.Width = pFont.TextWidth("M") * 20
Else
curFieldPrint.Width = (fld.Length / 3) * pFont.TextWidth("a")
Endif
curFieldPrint.Align = 1
End Select
'Comprobamos si entra en la página y si no creamos otra
pFont.Bold = True
curFieldPrint.Width = Max(curFieldPrint.Width, pFont.TextWidth(fld.Name))
If curPage.sFields.Count = 0 Then
curFieldPrint.X = LMargin + 2
curFieldPrint.Name = fld.Name
Else
'CurrentX es igual al anterior X + su ancho + 4 mm de separación
curFieldPrint.X = curPage.sFields[curPage.sFields.Count - 1].X + curPage.sFields[curPage.sFields.Count - 1].Width + 4
curFieldPrint.Name = fld.Name
Endif
If (curFieldPrint.X + curFieldPrint.Width + 2) > (RMargin) Then
curPage.lFirstRecord = 0
curPage.lLastRecord = intRecordsPerPage - 1
Pages.Add(curPage)
curFieldPrint.X = LMargin + 2
curPage = New Page
curPage.sFields = New FieldPrint[]
Inc iRowPages
Endif
curPage.sFields.Add(curFieldPrint)
Next
curPage.lFirstRecord = 0
curPage.lLastRecord = intRecordsPerPage - 1
Pages.Add(curPage)
IRowPages = Pages.Count
iColPages = Int(resDatos.Count / intRecordsPerPage) 'Páginas necesarias para cada columna de datos
'El número total de páginas es iRowPages * iColPages
If resDatos.Count Mod intRecordsPerPage Then Inc iColPages
For cp = 1 To iColPages - 1 'cp es contador para iColPages Contamos desde 1 porque la primera fila de páginas
'ya ha sido definida
For rp = 0 To iRowPages - 1 'rp es contador de iRowPages
curPage = New Page
curPage.sFields = Pages[rp].sFields 'Cada fila de páginas clona la definición de campos de la anterior
'Definiendo filas del resultado a imprimir en la página
curPage.lFirstRecord = cp * intRecordsPerPage
curPage.lLastRecord = (cp + 1) * intRecordsPerPage - 1
'Cuidamos no pasar del último registro aunque en la página quepan más filas
If curPage.lLastRecord > resDatos.Count - 1 Then curPage.lLastRecord = resDatos.Count - 1
Pages.Add(curPage)
Next
Next
'Debug "Páginas a imprimir " & Str(Pages.Count)
pPrinter.Count = Pages.Count
End
Public Sub FPrinter_Draw()
'Este evento se dispara para cada página a imprimir
Dim fp As FieldPrint, r As Integer
Dim sTexto As String
'Debug "Llegamos a la impresión"
Paint.Font = Font[pFont.ToString()]
Paint.LineWidth = 0.1
Paint.Font.Size = fTitleFontSize
Debug Paint.Font.ToString
Paint.DrawText("Este es el título", LMargin, TMargin, pPrinter.PaperWidth - LMargin * 2, fTitleHeight, Align.Center)
Debug "TextExtends alto " & Paint.TextExtents("Este es el título").Height
iYPos = TMargin + fTitleHeight
' Paint.MoveTo(LMargin, iYPos)
' Paint.LineTo(RMargin, iYPos)
Paint.Font.Size = fLineFontSize
Debug Paint.Font.ToString
Paint.Font.Bold = True
Paint.MoveTo(LMargin, iYpos)
Paint.LineTo(LMargin, BMargin - fLineHeight * 1.5)
For Each fp In Pages[pPrinter.Page - 1].sFields
Paint.drawText(fp.Name, fp.X, iYPos, Paint.TextExtents(fp.Name).Width, fLineHeight, Align.Left)
'Paint.Fill
Paint.MoveTo(fp.X + fp.Width + 2, iYPos)
Paint.LineTo(fp.X + fp.Width + 2, BMargin - fLineHeight * 1.5)
Paint.Stroke
Next
Paint.MoveTo(LMargin, TMargin + fTitleHeight)
Paint.LineTo(fp.X + fp.Width + 2, TMargin + fTitleHeight)
Paint.MoveTo(LMargin, TMargin + fTitleHeight + fLineHeight)
Paint.LineTo(fp.X + fp.Width + 2, TMargin + fTitleHeight + fLineHeight)
Paint.MoveTo(LMargin, BMargin - fLineHeight * 1.5)
Paint.LineTo(fp.X + fp.Width + 2, BMargin - fLineHeight * 1.5)
Paint.Stroke
iypos += fLineHeight
' Paint.MoveTo(LMargin, iYPos)
' Paint.LineTo(RMargin, iYPos)
Paint.MoveTo(LMargin, iYPos - fLineHeight)
Paint.LineTo(LMargin, BMargin - fLineHeight * 1.5)
Paint.Stroke
Paint.Font.Bold = False
For r = Pages[pPrinter.Page - 1].lFirstRecord To Pages[pPrinter.Page - 1].lLastRecord
'Debug "Record " & Str(r)
resDatos.MoveTo(r)
With Pages[pPrinter.Page - 1]
For Each fp In .sFields
Paint.drawText(resDatos[fp.Name], fp.X, iYPos, fp.Width, fLineHeight, fp.Align)
'Paint.Fill
Next
End With
'Inc r
iYPos += fLineHeight
Next
Paint.Font.Bold = True
iypos = BMargin - fLineHeight
Paint.DrawText("Página " & Str(pPrinter.Page), LMargin, iypos, pPrinter.PaperWidth - LMargin * 2, fLineHeight, Align.center)
End
' *********************************************************************************************
' Esta clase dispone lo necesario para crear un listado a partir de un resultado
' ************************************************************************************************
Private iPages As Integer
Private iYPos As Integer
Private RMargin As Integer
Private LMargin As Integer
Private TMargin As Integer
Private BMargin As Integer
Private resDatos As Result
Private PrinterName As String
Private pPrinter As Printer
Private FontName As String
Private pFont As Font
Private bolPDF As Boolean
Private iOrientation As Integer
Private sTitulo As String
Private fLineHeight As Float
Private fTitleHeight As Float
Private fTitleFontSize As Float
Private fLineFontSize As Float
Public Struct FieldPrint
'Esta estructura determina las características de un campo en la impresión
Name As String
X As Integer
Width As Integer
Align As Integer
End Struct
Public Struct Page
'Esta estructura determina la estructura de una página
sFields As FieldPrint[]
lFirstRecord As Long
lLastRecord As Long
End Struct
Private Pages As Page[] 'Almacenará las estructuras de todas las páginas que intervienen en el listado
Public Sub _new(res As Result, titulo As String, Optional sPrinter As String = "", Optional sFont As String = "Serif", Optional fFontSize As Integer = 3.5, Optional orientation As Integer = 0, Optional generarPDF As Boolean = False)
resDatos = res
bolPDF = generarPDF
'*******************************************************
iOrientation = orientation 'Esto no funciona
'*******************************************************
sTitulo = titulo
fTitleFontSize = fFontSize * 1.5
fLineFontSize = fFontSize
PrinterName = sPrinter
FontName = sFont
End
Public Sub Imprimir()
pPrinter = New Printer As "FPrinter"
If bolPDF Then
pPrinter.Name = "Imprimir a un archivo"
Dialog.Title = "Archivo destino"
Dialog.Path = "/tmp/" & sTitulo
Dialog.Filter = ["*.pdf", "Formato de documento portable"]
Dialog.AutoExt = True
Dialog.SaveFile
pPrinter.OutputFile = Dialog.Path
Else
If Not PrinterName Then
If pPrinter.Configure() Then Return
Endif
Endif
'Para calcular las posiciones de impresión de cada elemento lo hacemos sobre el área completa de la página y no sobre la
'parte efectivamente imprimible
pPrinter.FullPage = True
Inc Application.Busy
'Esto no funciona cuando la orientación es 1 - Landscape
'Lo mismo sucederá si se abre el diálogo de configuración de impresoras y se selecciona landscape en este
''*********************************************
'pPrinter.Orientation = iOrientation
'**********************************************
pPrinter.print 'Dispara el evento Printer_Begin()
Dec Application.Busy
Catch
Message.Error("Error " & Error.Code & " " & Error.Text, "Aceptar")
End
Public Sub FPrinter_Begin()
'La impresión se hace mediante Paint así que establecemos las medidas de Paint a las de nuestra página
Paint.Scale((Paint.Width) / pPrinter.PaperWidth, (Paint.Height) / pPrinter.PaperHeight) 'Cooordenadas en milímetros
pfont = New Font(FontName)
LMargin = 12
RMargin = pPrinter.PaperWidth - LMargin
TMargin = 10
BMargin = pPrinter.PaperHeight - 15
'Aquí tenemos dos opciones que son:
'1 - Indicar el número de páginas a imprimir si podemos conocerlo por ser un listado simple
'pPrinter.Count = iPages
'2 - comentar la línea anterior y utilizar el evento Paginate para calcular el número de páginas a imprimir.
'El evento paginate se dispara si dentro del evento Begin en que estamos no se asigna ninguna cantidad a Count
End
Public Sub FPrinter_Paginate()
Dim fld As ResultField, curFieldPrint As FieldPrint, intRecordsPerPage As Integer, curPage As Page, iColPages As Integer
Dim cp As Integer, rp As Integer, iRowPages As Integer
Debug "Paginando"
'Determinando la altura de la línea de título
pFont.Size = fTitleFontSize
fTitleHeight = pFont.TextHeight("H")
'determinando la altura de la línea de texto
pFont.Size = fLineFontSize
fLineHeight = pFont.TextHeight("H")
'Creando las definiciones de páginas
Pages = New Page[]
curPage = New Page
iRowPages = 1 'iRowPages contendrá el número de páginas que ocupa cada fila de datos teniendo en cuenta el tamaño
'de la impresión
curPage.sFields = New FieldPrint[]
pFont.Size = fLineFontSize
'El número de registros que cabrán por página se calcula restando del margen inferior el margen superior, el alto del título,
'el alto de los títulos de columnnas 1 líneas y 1.5 líneas para el número de página
intRecordsPerPage = (BMargin - TMargin - fTitleHeight - fLineHeight - fLineHeight * 1.5) / fLineHeight
For Each fld In resDatos.Fields
curFieldPrint = New FieldPrint
Select Case fld.Type
Case gb.Boolean
curFieldPrint.Width = pFont.TextWidth("T")
curFieldPrint.Align = 3
Case gb.Integer
curFieldPrint.Width = pFont.TextWidth("12345")
curFieldPrint.Align = 2
Case GB.Long
curFieldPrint.Width = pFont.TextWidth("1234567")
curFieldPrint.Align = 2
Case gb.Float
curFieldPrint.Width = pFont.TextWidth("12345,12")
curFieldPrint.Align = 2
Case gb.Date
curFieldPrint.Width = pFont.TextWidth("01/01/0000")
curFieldPrint.Align = 3
Case gb.String
If (fld.Length / 3) > 20 Then 'Length devuelve tres veces la longitud de la cadena
curFieldPrint.Width = pFont.TextWidth("M") * 20
Else
curFieldPrint.Width = (fld.Length / 3) * pFont.TextWidth("a")
Endif
curFieldPrint.Align = 1
End Select
'Comprobamos si entra en la página y si no creamos otra
pFont.Bold = True
curFieldPrint.Width = Max(curFieldPrint.Width, pFont.TextWidth(fld.Name))
If curPage.sFields.Count = 0 Then
curFieldPrint.X = LMargin + 2
curFieldPrint.Name = fld.Name
Else
'CurrentX es igual al anterior X + su ancho + 4 mm de separación
curFieldPrint.X = curPage.sFields[curPage.sFields.Count - 1].X + curPage.sFields[curPage.sFields.Count - 1].Width + 4
curFieldPrint.Name = fld.Name
Endif
If (curFieldPrint.X + curFieldPrint.Width + 2) > (RMargin) Then
curPage.lFirstRecord = 0
curPage.lLastRecord = intRecordsPerPage - 1
Pages.Add(curPage)
curFieldPrint.X = LMargin + 2
curPage = New Page
curPage.sFields = New FieldPrint[]
Inc iRowPages
Endif
curPage.sFields.Add(curFieldPrint)
Next
curPage.lFirstRecord = 0
curPage.lLastRecord = intRecordsPerPage - 1
Pages.Add(curPage)
IRowPages = Pages.Count
iColPages = Int(resDatos.Count / intRecordsPerPage) 'Páginas necesarias para cada columna de datos
'El número total de páginas es iRowPages * iColPages
If resDatos.Count Mod intRecordsPerPage Then Inc iColPages
For cp = 1 To iColPages - 1 'cp es contador para iColPages Contamos desde 1 porque la primera fila de páginas
'ya ha sido definida
For rp = 0 To iRowPages - 1 'rp es contador de iRowPages
curPage = New Page
curPage.sFields = Pages[rp].sFields 'Cada fila de páginas clona la definición de campos de la anterior
'Definiendo filas del resultado a imprimir en la página
curPage.lFirstRecord = cp * intRecordsPerPage
curPage.lLastRecord = (cp + 1) * intRecordsPerPage - 1
'Cuidamos no pasar del último registro aunque en la página quepan más filas
If curPage.lLastRecord > resDatos.Count - 1 Then curPage.lLastRecord = resDatos.Count - 1
Pages.Add(curPage)
Next
Next
'Debug "Páginas a imprimir " & Str(Pages.Count)
pPrinter.Count = Pages.Count
End
Public Sub FPrinter_Draw()
'Este evento se dispara para cada página a imprimir
Dim fp As FieldPrint, r As Integer
Dim sTexto As String
'Debug "Llegamos a la impresión"
Paint.Font = Font[pFont.ToString()]
Paint.LineWidth = 0.1
Paint.Font.Size = fTitleFontSize
Debug Paint.Font.ToString
Paint.DrawText("Este es el título", LMargin, TMargin, pPrinter.PaperWidth - LMargin * 2, fTitleHeight, Align.Center)
Debug "TextExtends alto " & Paint.TextExtents("Este es el título").Height
iYPos = TMargin + fTitleHeight
' Paint.MoveTo(LMargin, iYPos)
' Paint.LineTo(RMargin, iYPos)
Paint.Font.Size = fLineFontSize
Debug Paint.Font.ToString
Paint.Font.Bold = True
Paint.MoveTo(LMargin, iYpos)
Paint.LineTo(LMargin, BMargin - fLineHeight * 1.5)
For Each fp In Pages[pPrinter.Page - 1].sFields
Paint.drawText(fp.Name, fp.X, iYPos, Paint.TextExtents(fp.Name).Width, fLineHeight, Align.Left)
'Paint.Fill
Paint.MoveTo(fp.X + fp.Width + 2, iYPos)
Paint.LineTo(fp.X + fp.Width + 2, BMargin - fLineHeight * 1.5)
Paint.Stroke
Next
Paint.MoveTo(LMargin, TMargin + fTitleHeight)
Paint.LineTo(fp.X + fp.Width + 2, TMargin + fTitleHeight)
Paint.MoveTo(LMargin, TMargin + fTitleHeight + fLineHeight)
Paint.LineTo(fp.X + fp.Width + 2, TMargin + fTitleHeight + fLineHeight)
Paint.MoveTo(LMargin, BMargin - fLineHeight * 1.5)
Paint.LineTo(fp.X + fp.Width + 2, BMargin - fLineHeight * 1.5)
Paint.Stroke
iypos += fLineHeight
' Paint.MoveTo(LMargin, iYPos)
' Paint.LineTo(RMargin, iYPos)
Paint.MoveTo(LMargin, iYPos - fLineHeight)
Paint.LineTo(LMargin, BMargin - fLineHeight * 1.5)
Paint.Stroke
Paint.Font.Bold = False
For r = Pages[pPrinter.Page - 1].lFirstRecord To Pages[pPrinter.Page - 1].lLastRecord
'Debug "Record " & Str(r)
resDatos.MoveTo(r)
With Pages[pPrinter.Page - 1]
For Each fp In .sFields
Paint.drawText(resDatos[fp.Name], fp.X, iYPos, fp.Width, fLineHeight, fp.Align)
'Paint.Fill
Next
End With
'Inc r
iYPos += fLineHeight
Next
Paint.Font.Bold = True
iypos = BMargin - fLineHeight
Paint.DrawText("Página " & Str(pPrinter.Page), LMargin, iypos, pPrinter.PaperWidth - LMargin * 2, fLineHeight, Align.center)
End