comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

Imprimir un RichTextBox tal y como se ve

  • 0 Respuestas
  • 1623 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Conectado ANTRAX

  • *
  • Administrator
  • Mensajes: 5320
  • Actividad:
    41.67%
  • Reputación 29
  • ANTRAX
    • Ver Perfil
    • Underc0de
    • Email
  • Skype: underc0de.org
  • Twitter: @Underc0de
« en: Julio 26, 2010, 11:20:39 am »
Imprimir un RichTextBox con su formato original.

Código: Visual Basic
  1. Private Sub Command1_Click()
  2. On Error GoTo ErrorDeImpresion
  3. Printer.Print ""
  4. RichTextBox1.SelPrint Printer.hDC
  5. Printer.EndDoc
  6. Exit Sub
  7. ErrorDeImpresion:
  8. Exit Sub
  9. End Sub


Otra forma:

En el Formulario [Form1 por defecto] :

Código: Visual Basic
  1. Private Sub Form_Load() Dim LineWidth As Long Me.Caption = "Rich Text Box Ejemplo de Impresion" Command1.Move 10, 10, 600, 380 Command1.Caption = "&Imprimir" RichTextBox1.SelFontName = "Verdana, Tahoma, Arial" RichTextBox1.SelFontSize = 10 LineWidth = WYSIWYG_RTF(RichTextBox1, 1440, 1440) Me.Width = LineWidth + 200End Sub Private Sub Form_Resize() RichTextBox1.Move 100, 500, Me.ScaleWidth - 200, Me.ScaleHeight - 600End Sub Private Sub Command1_Click() PrintRTF RichTextBox1, 1440, 1440, 1440, 1440End Sub Crear un módulo y escribir:
  2.  
  3. Private Type Rect
  4. Left As Long
  5. Top As Long
  6. Right As Long
  7. Bottom As Long
  8. End Type
  9.  
  10. Private Type CharRange
  11. cpMin As Long
  12. cpMax As Long
  13. End Type
  14.  
  15. Private Type FormatRange
  16. hdc As Long
  17. hdcTarget As Long
  18. rc As Rect
  19. rcPage As Rect
  20. chrg As CharRange
  21. End Type
  22.  
  23. Private Const WM_USER As Long = &H400
  24. Private Const EM_FORMATRANGE As Long = WM_USER + 57
  25. Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
  26. Private Const PHYSICALOFFSETX As Long = 112
  27. Private Const PHYSICALOFFSETY As Long = 113
  28. Private Declare Function GetDeviceCaps Lib "gdi32" ( _
  29. ByVal hdc As Long, ByVal nIndex As Long) As Long
  30. Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
  31. (ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long
  32. Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
  33. (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
  34. ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
  35.  
  36. Public Function WYSIWYG_RTF(RTF As RichTextBox, LeftMarginWidth As Long, _
  37. RightMarginWidth As Long) As Long
  38. Dim LeftOffset As Long, LeftMargin As Long, RightMargin As Long
  39. Dim LineWidth As Long
  40. Dim PrinterhDC As Long
  41. Dim r As Long
  42. Printer.Print Space(1)
  43. Printer.ScaleMode = vbTwips
  44. LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
  45. PHYSICALOFFSETX), vbPixels, vbTwips)
  46. LeftMargin = LeftMarginWidth - LeftOffset
  47. RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
  48. LineWidth = RightMargin - LeftMargin
  49. PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)
  50. r = SendMessage(RTF.hWnd, EM_SETTARGETDEVICE, PrinterhDC, _
  51. ByVal LineWidth)
  52. Printer.KillDoc
  53. WYSIWYG_RTF = LineWidth
  54. End Function
  55.  
  56. Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _
  57. TopMarginHeight, RightMarginWidth, BottomMarginHeight)
  58. Dim LeftOffset As Long, TopOffset As Long
  59. Dim LeftMargin As Long, TopMargin As Long
  60. Dim RightMargin As Long, BottomMargin As Long
  61. Dim fr As FormatRange
  62. Dim rcDrawTo As Rect
  63. Dim rcPage As Rect
  64. Dim TextLength As Long
  65. Dim NextCharPosition As Long
  66. Dim r As Long
  67. Printer.Print Space(1)
  68. Printer.ScaleMode = vbTwips
  69. LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
  70. PHYSICALOFFSETX), vbPixels, vbTwips)
  71. TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _
  72. PHYSICALOFFSETY), vbPixels, vbTwips)
  73. LeftMargin = LeftMarginWidth - LeftOffset
  74. TopMargin = TopMarginHeight - TopOffset
  75. RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
  76. BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset
  77. rcPage.Left = 0
  78. rcPage.Top = 0
  79. rcPage.Right = Printer.ScaleWidth
  80. rcPage.Bottom = Printer.ScaleHeight
  81. rcDrawTo.Left = LeftMargin
  82. rcDrawTo.Top = TopMargin
  83. rcDrawTo.Right = RightMargin
  84. rcDrawTo.Bottom = BottomMargin
  85. fr.hdc = Printer.hdc
  86. fr.hdcTarget = Printer.hdc
  87. fr.rc = rcDrawTo
  88. fr.rcPage = rcPage
  89. fr.chrg.cpMin = 0
  90. fr.chrg.cpMax = -1
  91. TextLength = Len(RTF.Text)
  92. Do
  93. NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr)
  94. If NextCharPosition >= TextLength Then Exit Do
  95. fr.chrg.cpMin = NextCharPosition
  96. Printer.NewPage
  97. Printer.Print Space(1)
  98. fr.hDC = Printer.hDC
  99. fr.hDCTarget = Printer.hDC
  100. Loop
  101. Printer.EndDoc
  102. r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal CLng(0))
  103. End Sub
« Última modificación: Julio 08, 2011, 10:20:53 am por ANTRAX »


 

¿Te gustó el post? COMPARTILO!



Como leer caracter por caracter de una cadena string

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1328
Último mensaje Julio 26, 2010, 11:42:21 am
por ANTRAX
Cómo ajustar la cadena introducida a formato numérico: "#,##"

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1111
Último mensaje Julio 26, 2010, 12:38:04 pm
por ANTRAX
Cómo ajustar la cadena introducida a formato de hora "00:00:00"

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1418
Último mensaje Julio 26, 2010, 12:36:23 pm
por ANTRAX
Manual de como bloquear CTRL+ALT+SUP, ALT+TAB, Y OTROS con Visual Basic en WinXP

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1748
Último mensaje Julio 26, 2010, 11:11:14 am
por ANTRAX
Como pasar de un texto a otro usando Enter

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1529
Último mensaje Julio 26, 2010, 10:28:10 am
por ANTRAX