Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0221: WYSIWYG mit einer RichtTextBox

 von 

Beschreibung 

Das Drucken einer RichTextBox unter VB ist nicht gerade sehr komfortabel. Man hat keinen Einfluss auf die Seitenränder und auch stimmt die Anzeige am Bildschirm nicht exakt mit dem Druckbild überein. Die RTB hat aber noch viele versteckte Möglichkeiten. Eine davon ist EM_FORMATRANGE und EM_SETTARGETDEVICE. Damit ist es möglich die RTB WYSIWYG fähig zu machen. Außerdem hat man über Formatrange hervorragende Möglichkeiten das Druckbild anzupassen und mit eigenen Druckausgaben sowie Fuss- und Kopfzeilen zu erweitern.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

CreateDCA (CreateDC), DeleteDC, GetDeviceCaps, SendMessageA (SendMessage)

Download:

Download des Beispielprojektes [4,52 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Die Komponente 'Microsoft Rich Textbox Control 6.0 (RICHTX32.OCX)' wird benötigt.
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (COMDLG32.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Standarddialog-Steuerelement "CommonDialog1"
' Steuerelement: RichTextBox "RichTextBox1"
' Steuerelement: Menü "Menu" (Index von 0 bis 20)
' Steuerelement: Menü "menuDatei" (Index von 0 bis 99) auf Menu

Option Explicit

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 wMsg As _
        Long, ByVal wParam As Long, lParam 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

Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC _
        As Long) As Long
        
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Const WM_USER As Long = &H400
Private Const EM_GETLINECOUNT As Long = &HBA
Private Const EM_LINEFROMCHAR As Long = &HC9
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Private Const EM_SCROLLCARET As Long = &HB7
Private Const EM_SCROLL As Long = &HB5
Private Const EM_LINESCROLL As Long = &HB6
Private Const EM_GETFIRSTVISIBLELINE As Long = &HCE
Private Const EM_LINELENGTH As Long = &HC1
Private Const EM_LINEINDEX As Long = &HBB

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

Private Type CharRange
  cpMin As Long
  cpMax As Long
End Type

Private Type FormatRange
  hDC As Long
  hdcTarget As Long
  rc As Rect
  rcPage As Rect
  chrg As CharRange
End Type

Dim PrtDC As Long
Dim ObererRand As Long
Dim LinkerRand As Long
Dim RechterRand As Long
Dim UntererRand As Long


Private Sub Form_Load()
Dim BW&, BH&, r&
Dim TopOffSet As Long
Dim LeftOffSet As Long

' Randeinstellungen
' Angaben in Twips
ObererRand = 1000
LinkerRand = 1200
RechterRand = 1000
UntererRand = 1000

' Druckerränder
' Linken Offset auslesen
LeftOffSet = Printer.ScaleX(GetDeviceCaps(Printer.hDC, _
             PHYSICALOFFSETX), vbPixels, vbTwips)
   
Dim LeftMargin As Long
Dim RightMargin As Long
Dim LineWidth As Long

' Eingestellter Druckbereich
LeftMargin = LinkerRand - LeftOffSet
RightMargin = (Printer.Width - RechterRand) - LeftOffSet

' Wird benötigt um der RTB die exacte Breite zu übergeben
LineWidth = RightMargin - LeftMargin

' Einen hDC vom Drucker erstellen für die RTB in WYSIWYG
PrtDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)

' Der RTF sagen das sie sich dem Druckbild anpassen soll (WYSIWYG)
r = SendMessage(RichTextBox1.hwnd, EM_SETTARGETDEVICE, PrtDC, _
                ByVal LineWidth)

End Sub

Private Sub Form_Unload(Cancel As Integer)
DeleteDC PrtDC

End Sub

Private Sub Menu_Click(Index As Integer)
If Index = 10 Then
    On Error Resume Next
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = cdlCFBoth Or cdlCFTTOnly Or cdlCFEffects
    CommonDialog1.ShowFont
    If Err = 0 Then
        With RichTextBox1
            .SelFontName = CommonDialog1.FontName
            .SelFontSize = CommonDialog1.FontSize
            .SelBold = CommonDialog1.FontBold
            .SelItalic = CommonDialog1.FontItalic
            .SelStrikeThru = CommonDialog1.FontStrikethru
            .SelUnderline = CommonDialog1.FontUnderline
            .SelColor = CommonDialog1.Color
        End With
    End If
End If
If Index = 20 Then
    Call MsgBox("WYSIWYG RichTextbox Editor" & vbCrLf & _
                "(c) Dirk Lietzow, ActiveVB 2000", _
                vbInformation, "WYSIWYG - RTB")
End If

End Sub

Private Sub menuDatei_Click(Index As Integer)
On Error Resume Next
Select Case Index
    Case 0
        RichTextBox1.TextRTF = ""
    Case 10
        CommonDialog1.CancelError = True
        CommonDialog1.ShowOpen
        If Err = 0 Then
            RichTextBox1.LoadFile CommonDialog1.filename
            Me.Caption = "WYSIWYG RichTextBox - " _
                         & CommonDialog1.filename
        End If
    Case 15
        CommonDialog1.CancelError = True
        CommonDialog1.ShowSave
        If Err = 0 Then
            RichTextBox1.SaveFile CommonDialog1.filename
        End If
    Case 18
        CommonDialog1.CancelError = True
        CommonDialog1.Flags = 0
        CommonDialog1.ShowPrinter
        If Err = 0 Then
            Call PrintRTB(RichTextBox1, LinkerRand, _
                          ObererRand, RechterRand, UntererRand)
        End If
    Case 99
        Unload Me
End Select

End Sub

Sub PrintRTB(RTF As RichTextBox, LeftMarginWidth As Long, _
             TopMarginHeight As Long, RightMarginWidth As Long, _
             BottomMarginHeight As Long)
             
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
Dim strHeader As String
Dim strFooter As String

    ' Kopf- und Fusszeile
    strHeader = "ActiveVB  " & Now
    strFooter = Mid$(Me.Caption, 23)

    'Initialisierung des Printers
    Printer.Print ""
    Printer.ScaleMode = vbTwips
    
    'Linken und Oberen Offset auslesen
    LeftOffSet = Printer.ScaleX(GetDeviceCaps(Printer.hDC, _
                                PHYSICALOFFSETX), vbPixels, _
                                vbTwips)
                                
    TopOffSet = Printer.ScaleY(GetDeviceCaps(Printer.hDC, _
                               PHYSICALOFFSETY), vbPixels, _
                               vbTwips)
   
    'Ränder berechnen
    LeftMargin = LeftMarginWidth - LeftOffSet
    TopMargin = TopMarginHeight - TopOffSet
    RightMargin = (Printer.ScaleWidth - RightMarginWidth) _
                   + LeftOffSet
                   
    BottomMargin = (Printer.ScaleHeight - BottomMarginHeight) _
                    + TopOffSet
    
    'Druckbarer Bereich in einer Variable speichern
    rcPage.Left = 0
    rcPage.Top = 0
    rcPage.Right = Printer.ScaleWidth
    rcPage.Bottom = Printer.ScaleHeight
    
    'Bereich in einer Veriable speichern, in dem gedruckt
    'werden soll
    rcDrawTo.Left = LeftMargin
    rcDrawTo.Top = TopMargin
    rcDrawTo.Right = RightMargin
    rcDrawTo.Bottom = BottomMargin
    
    'Druckerinstruktionen festlegen
    fr.hDC = Printer.hDC
    fr.hdcTarget = Printer.hDC
    fr.rc = rcDrawTo
    fr.rcPage = rcPage
    fr.chrg.cpMin = 0
    fr.chrg.cpMax = -1
    
    'Textlänge bestimmen
    TextLength = Len(RTF.Text)
    
    'Schriftgrösse/-art für Kopf-/Fusszeilen
    Printer.Font = "Courier New" '"Arial"
    Printer.FontSize = 11
       
    'Loop der alle Seiten ausdruckt
    Dim i As Integer:    i = 1
    Do
        'Text mit EM_FORMATRANGE ausdrucken
        NextCharPosition = SendMessage(RTF.hwnd, EM_FORMATRANGE, _
                                       1, fr)
        'Kopfzeile ausdrucken
        Printer.CurrentX = (Printer.ScaleWidth - _
                            Printer.TextWidth(strHeader)) / 2
                            
        Printer.CurrentY = (TopMargin - Printer.TextHeight("x")) _
                            / 2
                            
        Printer.Print strHeader
        'Fusszeile ausdrucken
        Printer.CurrentX = (Printer.ScaleWidth - _
                            Printer.TextWidth(strFooter)) / 2
                            
        Printer.CurrentY = BottomMargin + (Printer.ScaleHeight _
                           - BottomMargin - Printer.TextHeight("x")) _
                           / 2
                           
        Printer.Print strFooter
        'Seitennummer ausdrucken
        Printer.CurrentX = Printer.ScaleWidth - _
                           Printer.TextWidth("Seite " & i)
                           
        Printer.CurrentY = BottomMargin + (Printer.ScaleHeight - _
                           BottomMargin - Printer.TextHeight("x")) _
                           / 2
                           
        Printer.Print "Seite " & i
        'Falls alles ausgedruckt ist, Schleife verlassen
        If NextCharPosition >= TextLength Then Exit Do
        
        'Startposition für die nächste Seite
        fr.chrg.cpMin = NextCharPosition
        'Neue Seite beginnen
        Printer.NewPage
        Printer.Print ""
        fr.hDC = Printer.hDC
        fr.hdcTarget = Printer.hDC
        i = i + 1
    Loop
    
    'Druckauftrag abschliessen
    Printer.EndDoc
    
    'Control zurücksetzten
    r = SendMessage(RTF.hwnd, EM_FORMATRANGE, 0, ByVal CLng(0))
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 16 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Daniel am 01.03.2006 um 12:53

Hallo,
danke für den Super code.

Ich habe jetzt das Problem, dass ich auf der Seite 1
auch andere Texte und 1 bild mit ausdrucke.

Darunter beginnt dann der ausdruck der RTF Box.
Aus diesem Grund steht ObererRand auf 8000.

Wenn der Text in der RTF Box ziemlich lang ist, dann gehts auf der Seite 2 weiter mit der Positionierung 8000.

Wie kann ich das ändern, dass auf der Seite 2 usw. der Text
normal ca 1cm vom oberen rand weiter geruckt wird?

Bitte um hilfe, stehe total auf dem Schlauch.

Kommentar von Timo Böhme am 28.02.2006 um 10:37

@Stefan Tresch
RTF Text ohne Seitenvorschub: Da die RTB die Druckfunktion komplett selber übernimmt, kann ich mir nicht vorstellen, dass es hier eine Lösung gibt, den Druckbefehl nicht auszulösen und selber Hand anzulegen in den Druckdaten der RTB. Ich empfehle, den Ausdruck manuell vorzunehmen --> Ein Thema fürs Forum: [URL]http://foren.activevb.de/cgi-bin/foren/list.pl?forum=4[/URL]

Kommentar von Stefan Tresch am 28.02.2006 um 10:22

Hallo,
unten war die Frage schon mehrfach aufgetaucht. Wie kann ich feststellen an welcher Stelle der gedruckte Text zu Ende ist. Ich möchte nach dem RTF text noch weiteren Text drucken.

Gruß und Danke für Ideen
Stefan

Kommentar von Stefan Tresch am 27.02.2006 um 09:04

Die hier ausgetauchte Frage wie ich nach RTF Text nahtlos weiter drucken kann konnte ich hier nicht beantworten.
Kennt jemand eine Lösung wie ich das Ende des RTF Textes feststellen kann?

Danke Stefan

Kommentar von Timo www.goldengel.ch am 25.01.2006 um 15:43

Hier ein simples Beispiel um zu drucken.

@Martin Ehrly: Ich denke, wenn Du eine Grafik pixelmässig über den Bilschirm schieben möchtest, musst Du ein Objekt über die RichTextBox legen und mit der Maus verschiebbar machen. Die RichTextBox kann nur Bildelemente in den Text einfügen und keine Pixelbearbeitung von Bildern.

Ausserdem:

Private Sub Command1_Click()
CommonDialog1.Flags = cdlPDReturnDC + cdlPDNoPageNums
If RichTextBox1.SelLength = 0 Then
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDAllPages
Else
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDSelection
End If
CommonDialog1.ShowPrinter
Printer.Print ""
RichTextBox1.SelPrint CommonDialog1.hDC
End Sub

Kommentar von Martin Ehrly am 13.09.2005 um 15:29

Hallo,
ich bin auf der Suche nach infomaterial über das Einbinden von Grafiken in ein RTF-Feld und dazu noch die Möglichkeit, diese Grafik frei bewegen zu können. So wie man es aus Word her kennt.

Kommentar von Ulrich Kalvelage am 25.08.2005 um 15:01

Ich lade eine rtf Datei in die RTB und drucke diese aus. In dieser Datei ist eine Tabelle enthalten. Zeilenvorschübe innerhalb einer Zelle werden in der RTB und damit (WYSIWYG)beim Ausdruck ignoriert. Unter Word wird es korrekt angezeigt. Weiss jemand Rat ?

Kommentar von Frey Fredy am 05.05.2005 um 23:47

Tipp 0221 funktioniert ausgezeichnet!
Ich möchte aber 2 RTB-Texte auf eine Seite drucken!
Dies ist mir nicht gelungen!
Wäre dies mit einer spez. Codeerweiterung möglich?

Kommentar von M-IT am 25.10.2003 um 17:48

So kann man Alles oder Selection in RichTextBox drucken

Private Sub cmdPrintRichBox_Click()
CommonDialog1.Flags = cdlPDReturnDC + cdlPDNoPageNums

'Wenn keine Auswahl getroffen wurde drucke alles
If RichTextBox1.SelLength = 0 Then
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDAllPages
Else 'Oder Drucke Auswahl
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDSelection
End If
CommonDialog1.ShowPrinter
Printer.Print ""
RichTextBox1.SelPrint CommonDialog1.hDC

End Sub

Kommentar von Justus Metz am 12.10.2003 um 23:53

Hallo
Der gesammte Text geht einwandfrei. Leider ist es nicht möglich nur markierten Text zu drucken, es wird immer der gesamte Text gedruckt.

Kommentar von Walter Grimm am 02.07.2002 um 20:25

Hallo,
Die Ausgabe auf dem Drucker klappt problemlos. Was muss ich einstellen, um eine Druckvorschau zu erhalten?
Vielen Dank für diesen Tipp und Ihre Hilfe
Walter Grimm

Kommentar von Jürgen Heesen am 15.05.2002 um 16:31

zu Tip 0221:
Die Frage, wie nach dem Ausdruck von Richtext mit dieser Routine die aktuelle Druckposition (Printer.CurrentX / Y) festgestellt werden kann, um nahtlos weiteren Text anfügen zu können, scheint immer noch offen. Hat inzwischen jemand einen guten Tip?

Kommentar von gugler reinhold am 27.01.2002 um 23:23

ich habe den code auf zwei verschiedenen druckern getestet. ich verwende im text verschiedene schriftarten.
auf einem drucker, der billigste - lexmark 1100, funktioniert alles gut.
auf dem zweiten, teueren - hp deskjet 990cxi, funktioniert zwar die positionierung, jedoch wird der text in einer anderen schriftart, die ich nicht eingestellt habe, ausgedruckt - in einer schreibschrift (ich habe nicht genau geprüft, was für eine es genau ist).
woran kann das liegen ? die verwendeten schriftarten müssen doch im richttextformat gespeichert sein. sonst würde es ja auf dem anderen drucker auch nicht funktionieren.

Kommentar von Dirk Lietzow am 23.11.2000 um 20:53

Ich kann in diesem Tip keine Picturebox erkennen ....????
Bei mir und auf ganz vielen anderen Rechnern läuft diese Routine ohne Probleme und es ist mit Sicherheit WYSIWYG !
Man kann das Beispiel im Übrigen sehr wohl auf eine Picturebox übertragen und somit eine Druckvorschau realisieren.
Gruß,
Dirk

Kommentar von Michael am 23.11.2000 um 12:12

Eine Piturebox hat nicht die gleichen Methoden wie eine RTB. Deshalb ist dieser Code nicht lauffähig. Nimmt man ein RTB statt einer Picturebox läuft der Code. Aber vom WYSIWYG keine Spur.

Kommentar von Mario Ableidinger am 07.11.2000 um 15:53

Wie kann ich feststellen, wo der RTF-Text zu Ende ist (d. h. nach Ausdruck des RTF-Textes die aktuelle Printer.CurrentY Position feststellen)? Ich möchte unmittelbar nach dem RichText weiterdrucken.