Controle richtextbox imprimable avec les polices et couleurs

Soyez le premier à donner votre avis sur cette source.

Vue 11 650 fois - Téléchargée 1 615 fois

Description

Un controle DLL RichTextBox qui permet l'impression avec ses couleurs et polices.
Inclure le controle dans la boite à outils puis le poser sur la feuille.
Voir le test qui montre le code à utiliser.

Conclusion :


Tout n'est pas de moi, je l'ai adapté et expliqué.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

youil
Messages postés
67
Date d'inscription
vendredi 28 mars 2003
Statut
Membre
Dernière intervention
12 juillet 2011
-
Bonjour je trouve ta source super mais je ne comprends pas comment tu fais pour imprimer ton RichTextBox a un endroit précis dans la feuille.

Car je cherche de plus longtemps comment faire car moi j'ai un prog qui contient un viewer autocad et je veux imprimer son contenu dans le milieu de la feuille car j'écris du texte en haut et en bas.

J'ai essayer de passer par une image mais la qualité de l'impression est pas aussi bonne que si je l'imprime avec l'option du viewer.Alors ma question est comment faire pour imprimer le contenu du viewer comme toi tu as fait avec ton RichTextBox et de choisir ou l'imprimer.

Merci.
cs_labout
Messages postés
1356
Date d'inscription
samedi 8 décembre 2001
Statut
Membre
Dernière intervention
23 octobre 2006
5 -
c'est dans la fonction Public Function FormatRange de la classe et dans l'exemple dans Private Sub PrintDocument1_PrintPage
@+
youil
Messages postés
67
Date d'inscription
vendredi 28 mars 2003
Statut
Membre
Dernière intervention
12 juillet 2011
-
OK merci !!

Mais tu sais comment faire pour imprimer le contenu d'un viewer autocad comme le fait Excel, Word, Access avec les objetole.
mstaub
Messages postés
51
Date d'inscription
dimanche 24 août 2003
Statut
Membre
Dernière intervention
29 octobre 2010
1 -
Hello, je suis comme YOUIL j'aimerai imprimer un richtextbox ou je veux sur une page mais en plus je code en VB-6 ! bref je lance un appel puisque c'est faisable en vb-net je pense que logiquement en vb6 ça doit pouvoir se faire aussi, non?
collargol123
Messages postés
86
Date d'inscription
jeudi 24 octobre 2013
Statut
Membre
Dernière intervention
2 avril 2014
> mstaub
Messages postés
51
Date d'inscription
dimanche 24 août 2003
Statut
Membre
Dernière intervention
29 octobre 2010
-
A mettre dans ta form :
Function PrintPage()
'la bande gauche non imprimable (=LeftOffSet) fait 194 twips
'la bande supérieure non imprimable (=RightOffSet) fait 170 twips
' la zone imprimable est 11184 x 16116 (largeur x hauteur)
'imprimer RTF avec marges en Twips
PrintRTF txtEntete, txtEntete.Left + 194, txtEntete.Top + 170, 11184 - txtEntete.Left - txtEntete.Width + 194, 16116 - txtEntete.Top - txtEntete.Height + 170

etc ...

A mettre dans un module

Option Explicit

Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type CharRange
cpMin As Long ' First character of range (0 for start of doc)
cpMax As Long ' Last character of range (-1 for end of doc)
End Type

Private Type FormatRange
hdc As Long ' Actual DC to draw on
hdcTarget As Long ' Target DC for determining text formatting
rc As Rect ' Region of the DC to draw to (in twips)
rcPage As Rect ' Region of the entire DC (page size) (in twips)
chrg As CharRange ' Range of text to draw (see above declaration)
End Type

Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, _
lp As Any) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As Long, ByVal lpInitData As Long) As Long


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' PrintRTF - Prints the contents of a RichTextBox control using the
' provided margins
'
' RTF - A RichTextBox control to print
'
' LeftMarginWidth - Width of desired left margin in twips
'
' TopMarginHeight - Height of desired top margin in twips
'
' RightMarginWidth - Width of desired right margin in twips
'
' BottomMarginHeight - Height of desired bottom margin in twips
'
' Notes - If you are also using WYSIWYG_RTF() on the provided RTF
' parameter you should specify the same LeftMarginWidth and
' RightMarginWidth that you used to call WYSIWYG_RTF()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _
TopMarginHeight, RightMarginWidth, BottomMarginHeight)
Dim LeftOffset As Long, TopOffset As Long
Dim LeftMargin As Long, TopMargin As Long
Dim RightMargin As Long, BottomMargin As Long
Dim fr As FormatRange
Dim rcDrawTo As Rect
Dim rcPage As Rect
Dim TextLength As Long
Dim NextCharPosition As Long
Dim r As Long

' Start a print job to get a valid Printer.hDC
Printer.Print Space(1)
Printer.ScaleMode = vbTwips

' Get the offsett to the printable area on the page in twips
LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETX), vbPixels, vbTwips)
TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETY), vbPixels, vbTwips)

' Calculate the Left, Top, Right, and Bottom margins
LeftMargin = LeftMarginWidth - LeftOffset
TopMargin = TopMarginHeight - TopOffset
RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset

' Set printable area rect
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight

' Set rect in which to print (relative to printable area)
rcDrawTo.Left = LeftMargin
rcDrawTo.Top = TopMargin
rcDrawTo.Right = RightMargin
rcDrawTo.Bottom = BottomMargin

' Set up the print instructions
fr.hdc = Printer.hdc ' Use the same DC for measuring and rendering
fr.hdcTarget = Printer.hdc ' Point at printer hDC
fr.rc = rcDrawTo ' Indicate the area on page to draw to
fr.rcPage = rcPage ' Indicate entire size of page
fr.chrg.cpMin = 0 ' Indicate start of text through
fr.chrg.cpMax = -1 ' end of the text

' Get length of text in RTF
TextLength = Len(RTF.Text)

' Loop printing each page until done
Do
' Print the page by sending EM_FORMATRANGE message
NextCharPosition = SendMessage(RTF.hwnd, EM_FORMATRANGE, True, fr)
If NextCharPosition >= TextLength Then Exit Do 'If done then exit
fr.chrg.cpMin = NextCharPosition ' Starting position for next page
Printer.NewPage ' Move on to next page
Printer.Print Space(1) ' Re-initialize hDC
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
Loop

' Commit the print job
' Printer.EndDoc

' Allow the RTF to free up memory
r = SendMessage(RTF.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
End Sub



Printer.EndDoc

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.