Tipp 0271 Textverarbeitung mit der RichTextBox
Autor/Einsender:
Datum:
  Kilian Meyer
18.09.2002
Entwicklungsumgebung:   VB 5
Dieser Tipp zeigt recht gut, wie man mit der RichTextBox ein einfaches Textverarbeitungsprogramm entwickeln kann. Das Beispiel wurde sowohl mit einer Menüleiste als auch einer Symbolleiste (ToolBar) ausgestattet. Wie z.B. in Word, wird beim Auswählen eines Textes in der RichTextBox überprüft, ob der Text fett, kursiv, unterstrichen oder durchgestrichen ist, auch die Ausrichtung des Absatzes wird ermittelt und der entsprechende Zustand mit den jeweiligen Buttons auf der ToolBar angezeigt.
Man kann natürlich aber auch den Text in der RichTextBox durch Klick auf den entsprechenden Button schnell und einfach formatieren. Die RichTextBox bietet noch mehr Eigenschaften, wie z.B. Aufzählungsstile, die hier allerdings nicht berücksichtigt wurden. Einer Erweiterung des Tipps steht also nichts im Wege ;-)
 
Option Explicit

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

Const WM_PASTE = &H302

Private Sub mnuFileNew_Click()
  RTFBox.Text = vbNullString
End Sub

Private Sub mnuFileOpen_Click()
  On Error GoTo errHandler
  RTFBox.LoadFile App.Path & "\test.rtf"

  Exit Sub

errHandler:
  If Err.Number <> 0 Then
    MsgBox "Fehler " & Str$(Err.Number) & ": " & vbCrLf & _
        Err.Description, vbOKOnly + vbCritical, _
        Title:=Me.Caption
  End If
End Sub

Private Sub mnuFileSave_Click()
  RTFBox.SaveFile App.Path & "\test.rtf"
End Sub

Private Sub mnuFileQuit_Click()
  Unload Me
  End
End Sub

Private Sub mnuFormatFont_Click()
  With CommonDialog1
    .FontBold = GetFontStyle(RTFBox.SelBold, False)
    .FontItalic = GetFontStyle(RTFBox.SelItalic, False)
    .FontUnderline = GetFontStyle(RTFBox.SelUnderline, False)
    .FontStrikethru = GetFontStyle(RTFBox.SelStrikeThru, False)
    .Color = GetFontStyle(RTFBox.SelColor, 0)

    .FontName = GetFontStyle(RTFBox.SelFontName, "")
    .FontSize = GetFontStyle(RTFBox.SelFontSize, 0)

    On Error Resume Next
    .Flags = cdlCFScreenFonts Or cdlCFEffects
    .ShowFont
    If Err.Number = cdlCancel Then
      Exit Sub
    ElseIf Err.Number <> 0 Then
      MsgBox "Fehler " & Str$(Err.Number) & _
          " bei Auswahl der Schriftart." & _
          vbCrLf & Err.Description, _
          Title:=Me.Caption
      Exit Sub
    End If
    On Error GoTo 0

    RTFBox.SelBold = .FontBold
    RTFBox.SelItalic = .FontItalic
    RTFBox.SelUnderline = .FontUnderline
    RTFBox.SelStrikeThru = .FontStrikethru
    RTFBox.SelColor = .Color

    RTFBox.SelFontName = .FontName
    RTFBox.SelFontSize = .FontSize
  End With
End Sub

Private Function GetFontStyle(ByVal varStyle As Variant, _
          ByVal varDefault As Variant) As Variant
  If IsNull(varStyle) Then
    GetFontStyle = varDefault
  Else
    GetFontStyle = varStyle
  End If
End Function

Private Sub ToolBar1_ButtonClick(ByVal Button As Button)

  Select Case Button.Key
    Case Is = "bold"
      If Button.MixedState = True Then
        Button.MixedState = False
      End If
      RTFBox.SelBold = Abs(RTFBox.SelBold) - 1

    Case Is = "italic"
      If Button.MixedState = True Then
        Button.MixedState = False
      End If
      RTFBox.SelItalic = Abs(RTFBox.SelItalic) - 1

    Case Is = "underline"
      If Button.MixedState = True Then
        Button.MixedState = False
      End If
      RTFBox.SelUnderline = Abs(RTFBox.SelUnderline) - 1

    Case Is = "strikethru"
      If Button.MixedState = True Then
        Button.MixedState = False
      End If
      RTFBox.SelStrikeThru = Abs(RTFBox.SelStrikeThru) - 1

    Case Is = "left"
      RTFBox.SelAlignment = rtfLeft

    Case Is = "center"
      RTFBox.SelAlignment = rtfCenter

    Case Is = "right"
      RTFBox.SelAlignment = rtfRight
  End Select
End Sub

Private Sub RTFBox_SelChange()
  With ToolBar1
    With .Buttons("bold")
      If .MixedState = True Then
        .MixedState = False
      End If
    End With
    '... 
    '... 
  End With

  Select Case RTFBox.SelBold
    Case 0
      ToolBar1.Buttons("bold").Value = tbrUnpressed

    Case -1
      ToolBar1.Buttons("bold").Value = tbrPressed

    Case Else
      ToolBar1.Buttons("bold").MixedState = True
  End Select

  '... 
  '... 

  Select Case RTFBox.SelAlignment
    Case Is = rtfLeft
      ToolBar1.Buttons("left").Value = tbrPressed

    Case Is = rtfRight
      ToolBar1.Buttons("right").Value = tbrPressed

    Case Is = rtfCenter
      ToolBar1.Buttons("center").Value = tbrPressed

    Case Else
      With ToolBar1
        .Buttons("left").Value = tbrUnpressed
        .Buttons("right").Value = tbrUnpressed
        .Buttons("center").Value = tbrUnpressed
      End With
  End Select
End Sub

Private Sub Picture2_DblClick(Index As Integer)
  Clipboard.Clear
  Clipboard.SetData Picture2(Index).Image
  SendMessage RTFBox.hwnd, WM_PASTE, 0, 0
  RTFBox.SetFocus
End Sub
 
Weitere Links zum Thema
SyntaxHighlighting
Hinweis
Um diesen Tipp ausführen zu können, muss das Microsoft Rich Textbox Control als Komponente in das Projekt eingebunden werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (11,6 kB) Downloads bisher: [ 3699 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 12. September 2011