Imprimer le contenu d'un RichTextBox sans utiliser SelPrint

La méthode SelPrint du RichtextBox est boguée. Microsoft lui-même le reconnaît et dit qu'il n'y a pas de solution autre que l'utilisation des APIs. Le symptôme est le suivant : dans certains cas et avec certaines imprimantes, surtout si le texte est long, la totalité n'est pas imprimée. Une partie manque.

Cliquez pour décharger ou lire la note Q173362 de Microsoft à ce sujet.

De plus, la méthode SelPrint est limitée et ne permet pas, entre autres, le WYSIWYG (What You See Is What You Get = Ce que vous voyez correspond à ce qui sera imprimé).

Autre inconvénient : la méthode SelPrint ne permet pas le placement du texte à imprimer à l'endroit voulu et dans un cadre de dimension choisie.

Dans le code suivant, on veut prévoir (facultatif) et imprimer le contenu d'un RichTextBox en utilisant l'objet Printer de VB. La méthode indiquée ici peut évidemment être appliquée si on utilise un autre outil que l'objet Printer, pourvu qu'on dispose du HDC de destination (Handle du Device Context pour l'imprimante).

Attention : l'unité de mesure est obligatoirement le Twip. On peut calculer les dimensions voulues sachant que :
         1 Pouce = 1440 Twips
         1 Pouce = 2.54 cm
         Donc : 1 cm = 567 Twips

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

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 ' HDC de destination
         hdcTarget As Long ' HDC de référence pour le formatage du texte
         rc As RECT ' Région du DC à imprimer (en Twips)
         rcPage As RECT ' Région de la page entière du DC (en Twips)
         chrg As CharRange ' Portion du texte à imprimer
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

Dim fr As FormatRange
Dim rcPage As RECT, rcDrawTo As RECT
Dim rc As Long, LineWidth As Long, NextCharPosition As Long, TextLength As Long

' Initialisation de l'objet Printer
Printer.Print Space(1)

' On choisit par exemple une marge de 5 mm de chaque côté
LineWidth = Printer.ScaleWidth - 2 * 283

rc = SendMessage(MyRichTextBox.hwnd, EM_SETTARGETDEVICE, Printer.hdc, ByVal LineWidth)

' On annule le job temporaire de Printer
Printer.KillDoc

' Ce message a pour effet de régler les marges du contrôle MyRichTextBox
' de manière que le texte soit formatté comme il sera imprimé.
' La valeur de LineWidth peut, si on veut, servir à redimensionnet le contrôle

' On définit le HDC
Printer.Print ""

TextLength = Len(MyRichTextBox.Text)

' On définit la partie imprimable de la feuille (le Printer doit être en mode Twips)
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight

' On prévoit par exemple une marge de 5 mm sur le pourtour de la zone imprimable
' 1 Pouce = 1440 Twips = 2.54 cm ==> 0.5 cm = 283 Twips
rcDrawTo.Left = 283
rcDrawTo.Top = 283
rcDrawTo.Right = 283
rcDrawTo.Bottom = 283

' On définit les membres de la structure Formatrange
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
fr.rc = rcDrawTo ' Précise la zone de la page où on veut imprimer le texte
fr.rcPage = rcPage ' Précise la taille de la zone imprimable de la feuille
fr.chrg.cpMin = 0 ' Indique la position du début du texte à imprimer
fr.chrg.cpMax = -1 ' Indique la position de fin du texte à imprimer (-1 pour la totalité)

' On boucle jusqu'à ce que toutes les pages aient été remplies
Do
         ' On remplit la page en envoyant le message EM_FORMATRANGE
         NextCharPosition = SendMessage(MyRichTextBox.hwnd, EM_FORMATRANGE, True, fr)
         If NextCharPosition >= TextLength Then Exit Do ' Si c'est fini, on sort de la boucle
         fr.chrg.cpMin = NextCharPosition ' Position de départ pour la page suivante
         Printer.NewPage
Loop

' On imprime
Printer.EndDoc

' On libère la mémoire
rc = SendMessage(MyRichTextBox.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))