VB 5/6-Tipp 0221: WYSIWYG mit einer RichtTextBox
von Dirk Lietzow
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: | Verwendete API-Aufrufe: CreateDCA (CreateDC), DeleteDC, GetDeviceCaps, SendMessageA (SendMessage) | Download: |
'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-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
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.