![]() |
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
|
|
|
|
|
|
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: [ 3805 ]
|
|
|