AYUDA! Imprimir formulario en VB6

astro_zombie

astro_zombie

Bovino adicto
#1
#1
que tal! pues necesito de su ayuda :(

ando haciendo un programa en visual basic 6 y tengo que mandar a imprimir un formulario desde otro

osea, en el Form1 hay un boton que manda a imprimir el formulario Form2

pero necesito que el formulario Form2 se imprimia en blanco y negro porque lleva imagenes

entonces, para llamar la ventana de propiedades de impresion que codigo puedo usar? para que la persona q ocupe el programa decida si quiere imprimir a color o b/n y si quiere mas de una copia

espero haberme explicado y que puedan ayudarme
Saludos
 
H

Hades-sama

Bovino maduro
#2
#2
Hola, que tal !!! Mmmm.. para resolver este inconveniente, yo te sugeriría que utilices CommonDialog de Visual Basic para imprimir.

La info completa esta en este enlace:
http://msdn.microsoft.com/es-es/library/256tssz7%28v=vs.80%29.aspx

Del mismo modo, ya aterrizando una solución como tal, podrías intentar lo que pusieron en este otro enlace:

http://www.recursosvisualbasic.com.ar/htm/listado-api/156-commondialog-imprimir.htm


He aquí un preview:

El ejemplo permite abrir el diálogo de imprimir :



y el de configurar página :



Controles

  1. Colocar en un proyecto un módulo bas.
  2. En el formulario agregar dos Commandbutton.El Commnad1 muestra el cuadro de diálogo para Imprimir y el Command2 el de Configurar página.

Código fuente en el módulo bas:

Texto planoImprimir


  1. Option Explicit
  4. 'Constantes
  5. Const CCHDEVICENAME = 32
  6. Const CCHFORMNAME = 32
  7. Const DM_DUPLEX = &H1000&
  8. Const DM_ORIENTATION = &H1&
  9. Const PD_PRINTSETUP = &H40
  10. Const GMEM_MOVEABLE = &H2
  11. Const GMEM_ZEROINIT = &H40
  12. Const PD_DISABLEPRINTTOFILE = &H80000
  14. 'Funciones API
  15. Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" ( _
  16. pPrintdlg As PRINTDLG_TYPE) As Long
  17. Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" ( _
  18. pPagesetupdlg As PAGESETUPDLG) As Long
  19. Private Declare Function GlobalLock Lib "kernel32" ( _
  20. ByVal hMem As Long) As Long
  21. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  22. Private Declare Function GlobalAlloc Lib "kernel32" ( _
  23. ByVal wFlags As Long, _
  24. ByVal dwBytes As Long) As Long
  25. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  26. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
  27. hpvDest As Any, _
  28. hpvSource As Any, _
  29. ByVal cbCopy As Long)
  31. ' UDT
  32. Private Type POINTAPI
  33. x As Long
  34. y As Long
  35. End Type
  36. Private Type RECT
  37. Left As Long
  38. Top As Long
  39. Right As Long
  40. Bottom As Long
  41. End Type
  43. Private Type PAGESETUPDLG
  44. lStructSize As Long
  45. hwndOwner As Long
  46. hDevMode As Long
  47. hDevNames As Long
  48. Flags As Long
  49. ptPaperSize As POINTAPI
  50. rtMinMargin As RECT
  51. rtMargin As RECT
  52. hInstance As Long
  53. lCustData As Long
  54. lpfnPageSetupHook As Long
  55. lpfnPagePaintHook As Long
  56. lpPageSetupTemplateName As String
  57. hPageSetupTemplate As Long
  58. End Type
  61. Private Type PRINTDLG_TYPE
  62. lStructSize As Long
  63. hwndOwner As Long
  64. hDevMode As Long
  65. hDevNames As Long
  66. hDC As Long
  67. Flags As Long
  68. nFromPage As Integer
  69. nToPage As Integer
  70. nMinPage As Integer
  71. nMaxPage As Integer
  72. nCopies As Integer
  73. hInstance As Long
  74. lCustData As Long
  75. lpfnPrintHook As Long
  76. lpfnSetupHook As Long
  77. lpPrintTemplateName As String
  78. lpSetupTemplateName As String
  79. hPrintTemplate As Long
  80. hSetupTemplate As Long
  81. End Type
  82. Private Type DEVNAMES_TYPE
  83. wDriverOffset As Integer
  84. wDeviceOffset As Integer
  85. wOutputOffset As Integer
  86. wDefault As Integer
  87. extra As String * 100
  88. End Type
  90. Private Type DEVMODE_TYPE
  91. dmDeviceName As String * CCHDEVICENAME
  92. dmSpecVersion As Integer
  93. dmDriverVersion As Integer
  94. dmSize As Integer
  95. dmDriverExtra As Integer
  96. dmFields As Long
  97. dmOrientation As Integer
  98. dmPaperSize As Integer
  99. dmPaperLength As Integer
  100. dmPaperWidth As Integer
  101. dmScale As Integer
  102. dmCopies As Integer
  103. dmDefaultSource As Integer
  104. dmPrintQuality As Integer
  105. dmColor As Integer
  106. dmDuplex As Integer
  107. dmYResolution As Integer
  108. dmTTOption As Integer
  109. dmCollate As Integer
  110. dmFormName As String * CCHFORMNAME
  111. dmUnusedPadding As Integer
  112. dmBitsPerPel As Integer
  113. dmPelsWidth As Long
  114. dmPelsHeight As Long
  115. dmDisplayFlags As Long
  116. dmDisplayFrequency As Long
  117. End Type
  119. 'Fin de declaraciones
  121. '----------------------------------
  124. ' función Para el Common diálogo de Configurar página
  125. '---------------------------------------------------------
  126. Function Configuarar_Pagina(HwndForm As Long) As Long
  128. Dim T_Configurar_Pagina As PAGESETUPDLG
  131. With T_Configurar_Pagina
  132. .lStructSize = Len(T_Configurar_Pagina)
  133. .hwndOwner = HwndForm
  134. .hInstance = App.hInstance
  135. .Flags = 0
  136. End With
  138. If PAGESETUPDLG(T_Configurar_Pagina) Then
  139. Configuarar_Pagina = 0
  140. Else
  141. Configuarar_Pagina = -1
  142. End If
  143. End Function
  146. 'Para el Common diálogo de imprimir ( pasar el formulario como parámetro )
  147. '---------------------------------------------------------
  148. Public Sub Show_Printer(El_Formulario As Form, Optional Flags As Long)
  150. On Error GoTo ErrSub
  152. Dim t_Printer As PRINTDLG_TYPE
  153. Dim DevMode As DEVMODE_TYPE
  154. Dim DevName As DEVNAMES_TYPE
  156. Dim lpDevMode As Long, lpDevName As Long
  157. Dim bReturn As Integer
  158. Dim objPrinter As Printer, NewPrinterName As String
  160. With t_Printer
  161. .lStructSize = Len(t_Printer)
  162. .hwndOwner = El_Formulario.hWnd
  163. .Flags = Flags
  164. End With
  166. On Error Resume Next
  168. DevMode.dmDeviceName = Printer.DeviceName
  169. DevMode.dmSize = Len(DevMode)
  170. DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
  171. DevMode.dmPaperWidth = Printer.Width
  172. DevMode.dmOrientation = Printer.Orientation
  173. DevMode.dmPaperSize = Printer.PaperSize
  174. DevMode.dmDuplex = Printer.Duplex
  176. On Error GoTo 0
  178. t_Printer.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode))
  179. lpDevMode = GlobalLock(t_Printer.hDevMode)
  181. If lpDevMode > 0 Then
  182. CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
  183. bReturn = GlobalUnlock(t_Printer.hDevMode)
  184. End If
  187. With DevName
  188. .wDriverOffset = 8
  189. .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
  190. .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
  191. .wDefault = 0
  192. End With
  194. With Printer
  195. DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0)
  196. End With
  198. t_Printer.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevName))
  199. lpDevName = GlobalLock(t_Printer.hDevNames)
  201. If lpDevName > 0 Then
  202. CopyMemory ByVal lpDevName, DevName, Len(DevName)
  203. bReturn = GlobalUnlock(lpDevName)
  204. End If
  207. If PrintDialog(t_Printer) <> 0 Then
  208. lpDevName = GlobalLock(t_Printer.hDevNames)
  209. CopyMemory DevName, ByVal lpDevName, 45
  210. bReturn = GlobalUnlock(lpDevName)
  211. GlobalFree t_Printer.hDevNames
  214. lpDevMode = GlobalLock(t_Printer.hDevMode)
  215. CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
  216. bReturn = GlobalUnlock(t_Printer.hDevMode)
  217. GlobalFree t_Printer.hDevMode
  218. NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
  219. InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
  221. If Printer.DeviceName <> NewPrinterName Then
  222. For Each objPrinter In Printers
  223. If UCase$(objPrinter.DeviceName) = NewPrinterName Then
  224. Set Printer = objPrinter
  225. End If
  226. Next
  227. End If
  229. On Error Resume Next
  231. With Printer
  232. .PaperSize = DevMode.dmPaperSize
  233. .PrintQuality = DevMode.dmPrintQuality
  234. .ColorMode = DevMode.dmColor
  235. .PaperBin = DevMode.dmDefaultSource
  236. .Copies = DevMode.dmCopies
  237. .Duplex = DevMode.dmDuplex
  238. .Orientation = DevMode.dmOrientation
  239. End With
  240. On Error GoTo 0
  242. End If
  244. Exit Sub
  246. ErrSub:
  248. If Err.Number = 484 Then
  249. MsgBox "Error al obtener información de la impresora." & _
  250. "Asegurarse que está instalada correctamente.", vbCritical
  251. End If
  253. End Sub

Option Explicit 'Constantes Const CCHDEVICENAME = 32 Const CCHFORMNAME = 32 Const DM_DUPLEX = &H1000& Const DM_ORIENTATION = &H1& Const PD_PRINTSETUP = &H40 Const GMEM_MOVEABLE = &H2 Const GMEM_ZEROINIT = &H40 Const PD_DISABLEPRINTTOFILE = &H80000 'Funciones API Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" ( _ pPrintdlg As PRINTDLG_TYPE) As Long Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" ( _ pPagesetupdlg As PAGESETUPDLG) As Long Private Declare Function GlobalLock Lib "kernel32" ( _ ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalAlloc Lib "kernel32" ( _ ByVal wFlags As Long, _ ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ hpvDest As Any, _ hpvSource As Any, _ ByVal cbCopy As Long) ' UDT Private Type POINTAPI x As Long y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type PAGESETUPDLG lStructSize As Long hwndOwner As Long hDevMode As Long hDevNames As Long Flags As Long ptPaperSize As POINTAPI rtMinMargin As RECT rtMargin As RECT hInstance As Long lCustData As Long lpfnPageSetupHook As Long lpfnPagePaintHook As Long lpPageSetupTemplateName As String hPageSetupTemplate As Long End Type Private Type PRINTDLG_TYPE lStructSize As Long hwndOwner As Long hDevMode As Long hDevNames As Long hDC As Long Flags As Long nFromPage As Integer nToPage As Integer nMinPage As Integer nMaxPage As Integer nCopies As Integer hInstance As Long lCustData As Long lpfnPrintHook As Long lpfnSetupHook As Long lpPrintTemplateName As String lpSetupTemplateName As String hPrintTemplate As Long hSetupTemplate As Long End Type Private Type DEVNAMES_TYPE wDriverOffset As Integer wDeviceOffset As Integer wOutputOffset As Integer wDefault As Integer extra As String * 100 End Type Private Type DEVMODE_TYPE dmDeviceName As String * CCHDEVICENAME dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * CCHFORMNAME dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type 'Fin de declaraciones '---------------------------------- ' función Para el Common diálogo de Configurar página '--------------------------------------------------------- Function Configuarar_Pagina(HwndForm As Long) As Long Dim T_Configurar_Pagina As PAGESETUPDLG With T_Configurar_Pagina .lStructSize = Len(T_Configurar_Pagina) .hwndOwner = HwndForm .hInstance = App.hInstance .Flags = 0 End With If PAGESETUPDLG(T_Configurar_Pagina) Then Configuarar_Pagina = 0 Else Configuarar_Pagina = -1 End If End Function 'Para el Common diálogo de imprimir ( pasar el formulario como parámetro ) '--------------------------------------------------------- Public Sub Show_Printer(El_Formulario As Form, Optional Flags As Long) On Error GoTo ErrSub Dim t_Printer As PRINTDLG_TYPE Dim DevMode As DEVMODE_TYPE Dim DevName As DEVNAMES_TYPE Dim lpDevMode As Long, lpDevName As Long Dim bReturn As Integer Dim objPrinter As Printer, NewPrinterName As String With t_Printer .lStructSize = Len(t_Printer) .hwndOwner = El_Formulario.hWnd .Flags = Flags End With On Error Resume Next DevMode.dmDeviceName = Printer.DeviceName DevMode.dmSize = Len(DevMode) DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX DevMode.dmPaperWidth = Printer.Width DevMode.dmOrientation = Printer.Orientation DevMode.dmPaperSize = Printer.PaperSize DevMode.dmDuplex = Printer.Duplex On Error GoTo 0 t_Printer.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode)) lpDevMode = GlobalLock(t_Printer.hDevMode) If lpDevMode > 0 Then CopyMemory ByVal lpDevMode, DevMode, Len(DevMode) bReturn = GlobalUnlock(t_Printer.hDevMode) End If With DevName .wDriverOffset = 8 .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName) .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port) .wDefault = 0 End With With Printer DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0) End With t_Printer.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevName)) lpDevName = GlobalLock(t_Printer.hDevNames) If lpDevName > 0 Then CopyMemory ByVal lpDevName, DevName, Len(DevName) bReturn = GlobalUnlock(lpDevName) End If If PrintDialog(t_Printer) <> 0 Then lpDevName = GlobalLock(t_Printer.hDevNames) CopyMemory DevName, ByVal lpDevName, 45 bReturn = GlobalUnlock(lpDevName) GlobalFree t_Printer.hDevNames lpDevMode = GlobalLock(t_Printer.hDevMode) CopyMemory DevMode, ByVal lpDevMode, Len(DevMode) bReturn = GlobalUnlock(t_Printer.hDevMode) GlobalFree t_Printer.hDevMode NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _ InStr(DevMode.dmDeviceName, Chr$(0)) - 1)) If Printer.DeviceName <> NewPrinterName Then For Each objPrinter In Printers If UCase$(objPrinter.DeviceName) = NewPrinterName Then Set Printer = objPrinter End If Next End If On Error Resume Next With Printer .PaperSize = DevMode.dmPaperSize .PrintQuality = DevMode.dmPrintQuality .ColorMode = DevMode.dmColor .PaperBin = DevMode.dmDefaultSource .Copies = DevMode.dmCopies .Duplex = DevMode.dmDuplex .Orientation = DevMode.dmOrientation End With On Error GoTo 0 End If Exit Sub ErrSub: If Err.Number = 484 Then MsgBox "Error al obtener información de la impresora." & _ "Asegurarse que está instalada correctamente.", vbCritical End If End Sub
Código fuente en el formulario

Texto planoImprimir


  1. Option Explicit
  4. 'Abre el Diálogo Imprimir
  5. Private Sub Command1_Click()
  6. Call Show_Printer(Me)
  7. End Sub
  9. ' Abre el Diálogo de Configurar página
  10. Private Sub Command2_Click()
  11. Call Configuarar_Pagina(Me.hWnd)
  12. End Sub
  15. Private Sub Form_Load()
  17. Command1.Caption = " Show Printer "
  18. Command2.Caption = " Configuarar Pagina "
  20. End Sub
 
Debes iniciar sesión o registrarte para responder aquí.
Arriba