Sección de códigos , trucos y ejemplos para visual basic

371 - Visualizar Recordset en Picturebox tipo reporte

Ejemplo que recorre un recordset ado para ir imprimiendo en un control picture los registros , para crear un reporte simple

En el código fuente hay una función llamada ShowReport, que es la que recorre los registros del recordset y los imprime en el Picturebox :

formulario con los datos en el picture tipo reporte

A la función ShowReport , se le debe pasar como parámetro el recordset Ado y el PictureBox donde se visualizarán los datos, y también otros parámetros opcionales para mostrar un título, un pie de página y el color de la fuente del encabezado, los datos y el pie de página.

Nota: el código no incluye una opción para imprimir, solo vuelca los registros al picturebox

Ejemplo

Agregar la referencia a Ado ( Microsoft Activex Data Object )
Añadir un PictureBox
Un ScrollBar Horizontal y otro Scrollbar vertical
Un TextBox para escribir el comando sql
Un Command Button

Código fuente en el formulario

Option Explicit Private Declare Function LockWindowUpdate Lib "user32" ( _ ByVal hwndLock As Long) As Long Private Declare Function GetSystemMetrics Lib "user32" ( _ ByVal nIndex As Long) As Long Private Const SM_CYHSCROLL = 3 Private Const SM_CXVSCROLL = 2 'variable para el recordset y la coenxión Ado Dim cn As ADODB.Connection Dim rst As ADODB.Recordset ' variable de tipo Pictuerbox que es para el reporte Private PicReporte As PictureBox ' SubRutina que imprime los regisros en el picturebox _ para crear el reporte ( Recibe el recordset y el picturebox ) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub ShowReport(rs As ADODB.Recordset, _ Contenedor As Object, _ Optional TextHeader As String, _ Optional TextHeader2 As String, _ Optional TextFooter As String, _ Optional FontColorHeader As Long, _ Optional FontColorHeader2 As Long, _ Optional FontColorFooter As Long, _ Optional ForeColorRegistros As Long, _ Optional ForeColorField As Long, _ Optional Margen As Single = 100) On Error GoTo Error_Sub Dim Posy As Long Dim Posy2 As Long Dim posx As Long Dim AltoLetra As Long Dim Columna As Integer Dim Dato As String Dim MaxPosx As Long Dim Campo As Boolean Dim AltoPicture As Double Dim t As Long Me.MousePointer = vbHourglass ' crea un picturebox If PicReporte Is Nothing Then Set PicReporte = Me.Controls.Add("vb.PictureBox", "Pic1") End If ' borra el contenido del picture PicReporte.Cls ' para que se actualice mas rápido LockWindowUpdate PicReporte.hwnd ' propiedades varias With PicReporte Set .Container = Contenedor .Width = 3000 * Screen.TwipsPerPixelX .Appearance = 0 .BorderStyle = 1 .Visible = True .BackColor = vbWhite .AutoRedraw = True .CurrentX = Margen .CurrentY = 210 .FontName = "Arial" .FontSize = 12 .ForeColor = FontColorHeader End With AltoLetra = PicReporte.TextHeight("A") PicReporte.Height = (AltoLetra * 2) + PicReporte.CurrentY ' Enzabezado PicReporte.Print TextHeader ' Encabezado 2 With PicReporte .FontSize = 8 .Height = (AltoLetra * 2) + .CurrentY .ForeColor = FontColorHeader2 .CurrentX = Margen PicReporte.Print TextHeader2 PicReporte.Line (Margen, .CurrentY)-(3000 * Screen.TwipsPerPixelX, .CurrentY) End With Posy2 = PicReporte.CurrentY ' recorre las columnas For Columna = 0 To rs.Fields.Count - 1 Campo = True rst.MoveFirst Posy = Posy2 + AltoLetra + Margen ' currenty para escribir posx = (posx + MaxPosx) + 500 MaxPosx = 0 PicReporte.Height = ((rst.RecordCount) * (AltoLetra)) + (Posy * 2) 'Recorre los registros Do While Not rs.EOF If IsNull(rst(Columna).Value) Then Dato = vbNullString Else Dato = rst(Columna).Value End If If PicReporte.TextWidth(Dato) > MaxPosx Then MaxPosx = PicReporte.TextWidth(Dato) End If If Campo Then If PicReporte.TextWidth(rst(Columna).Name) > MaxPosx Then MaxPosx = PicReporte.TextWidth(rst(Columna).Name) End If ' propiedades de fuente para los campos With PicReporte .FontBold = True .FontUnderline = True .ForeColor = ForeColorField .FontSize = 8 End With ' imprime el texto de los campos Imprimir_dato posx, Posy, rst(Columna).Name Posy = Posy + AltoLetra Campo = False ' propiedades de fuente para los registros With PicReporte .FontBold = False .ForeColor = ForeColorRegistros .FontSize = 8 .FontUnderline = False End With Else ' imprime el dato del registro actual Call Imprimir_dato(posx, Posy, Dato) rs.MoveNext ' siguiente registro ' Establece el CurrentY Posy = Posy + AltoLetra End If Loop t = t + MaxPosx + 250 + (Margen * 4) Next If t < Printer.ScaleWidth Then PicReporte.Width = Printer.ScaleWidth Else PicReporte.Width = t End If ' Fin de los registros ''''''''''''''''''''''''''''' ' imprime el Pie de página PicReporte.Print "" PicReporte.Print "" PicReporte.ForeColor = FontColorFooter PicReporte.Line (Margen, PicReporte.CurrentY)- _ (3000 * Screen.TwipsPerPixelX, PicReporte.CurrentY) PicReporte.CurrentX = Margen PicReporte.CurrentY = Posy + AltoLetra PicReporte.Print TextFooter LockWindowUpdate False PicReporte.Refresh ' Establece las barras de scroll ShowScrollBar Picture1, PicReporte Me.MousePointer = 0 Exit Sub ' error Error_Sub: Me.MousePointer = 0 LockWindowUpdate False MsgBox Err.Description, vbCritical End Sub Private Sub Imprimir_dato(x As Long, _ y As Long, _ s As String) PicReporte.CurrentX = x + 250 PicReporte.CurrentY = y PicReporte.Print s; End Sub Private Sub Command1_Click() ' carga el recordset rst.Open Text1.Text, cn, adOpenStatic ShowReport rst, Picture1, _ "Ejemplo simple de reporte", _ "Total : (" & rst.RecordCount & " registros)", _ "Fin del listado - Fecha " & Date, _ &H8000000D, _ &H808080, _ &H808080, _ &H8000000D, _ &H808080 rst.Close End Sub Private Sub ShowScrollBar(picContenedor As Object, PicData As PictureBox) Dim W As Single Dim H As Single Set VScroll1.Container = picContenedor Set HScroll1.Container = picContenedor ' Izquierda y top del picture que tiene el reporte PicData.Move 70, 80 ' redimensiona los scrollbar W = GetSystemMetrics(SM_CXVSCROLL) * Screen.TwipsPerPixelX H = GetSystemMetrics(SM_CYHSCROLL) * Screen.TwipsPerPixelY HScroll1.Move 0, picContenedor.ScaleHeight - H, _ picContenedor.ScaleWidth - W, H VScroll1.Move picContenedor.ScaleWidth - W, 0, _ W, picContenedor.ScaleHeight ' Asigna los valores Max y Largchange de las barras de desplazamiento HScroll1.LargeChange = 15 VScroll1.LargeChange = 15 HScroll1.Max = (PicData.Width - picContenedor.ScaleWidth + _ VScroll1.Width) / 120 + 1 VScroll1.Max = (PicData.Height - picContenedor.ScaleHeight + _ HScroll1.Height) / 120 + 1 If PicData.Height <= picContenedor.Height Then VScroll1.Visible = False HScroll1.Width = picContenedor.ScaleWidth Else VScroll1.Visible = True End If If PicData.Width <= picContenedor.Width Then HScroll1.Visible = False VScroll1.Height = picContenedor.ScaleHeight Else HScroll1.Visible = True End If HScroll1.Value = 0 VScroll1.Value = 0 ' trae los controles hacia el frente HScroll1.ZOrder 0 VScroll1.ZOrder 0 End Sub ' eventos de los ScroolBar ''''''''''''''''''''''''''''''''' Private Sub HScroll1_Change() PicReporte.Left = (-HScroll1.Value * 120) + 70 End Sub Private Sub HScroll1_Scroll() HScroll1_Change End Sub Private Sub VScroll1_Change() PicReporte.Top = (-CSng(VScroll1.Value) * 120) + 80 End Sub Private Sub VScroll1_Scroll() VScroll1_Change End Sub ''''''''''''''''''''''''''''''''' Private Sub Form_Load() ' nueva conexión Ado Set cn = New ADODB.Connection cn.CursorLocation = adUseClient ' cadena de conexión (us la base de datos biblio del directorio de visual basic ) cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ "C:\Archivos de programa\Microsoft Visual Studio" & _ "\VB98\nwind.MDB;Persist Security Info=False" ' abre la conexión cn.Open ' Crear un nuevo recordset Set rst = New ADODB.Recordset Command1.Caption = "Mostrar reporte" Text1.Text = "Select * From Productos" VScroll1.Visible = False HScroll1.Visible = False End Sub

Recursos Visual basic - Enlaces relacionados

Recursos Visual basic.Net - Enlaces relacionados

Componente PrintForm para windows Forms de vb.net 2005

Buscar en Recursos vb