リッチテキストボックスでの基本的な操作例玄関へお回り下さい。
リッチテキストボックスでの基本的な操作例（1３例）　（API未使用で）　　（No.409）

１．右端で折り返されなくする方法（テキストの右余白を設定）
２．通常のテキストファイルを読み込み表示
３．リッチテキスト形式のファイルを読み込み表示
４．すべてのフォントをデフォルトに設定
５．通常のテキストファイルを保存する
６．リッチテキスト形式のファイルを保存する
７．選択箇所のフォント属性を設定する
８．選択箇所のフォントカラーの設定
９．指定の文字列を検索して指定のカラーで表示する
10．連続してリッチテキスト内を検索・置き換えする
11．リッチテキストを印刷
12．先頭行を削除
13．最終行を削除
使用するコントロールは RichTextBox1 と CommonDialog1 と CommandButton・TextBox を使用分
テスト環境　WindowsXP(Home SP2)  VB6.0(SP6)  
　　 １．右端で折り返されなくする方法（テキストの右余白を設定）

　　'テキストの右余白を設定します
　　'(大きな値を設定しておけば自動的に折り返さない）
　　RichTextBox1.RightMargin = 100000
　
　 ２．通常のテキストファイルを読み込み表示
３．リッチテキスト形式のファイルを読み込み表示

Private Sub Command1_Click()
　　'通常のテキストファイルを読み込む場合
'　　RichTextBox1.LoadFile "c:\test.txt", rtfText


　 CommonDialog1.Filter = "リッチテキスト形式ファイル|*.rtf"
　 CommonDialog1.ShowOpen
　 'リッチテキスト形式のファイルを読み込む場合
　 RichTextBox1.LoadFile CommonDialog1.FileName, rtfRTF

End Sub
　 ４．すべてのフォントをデフォルトに設定

Private Sub Command10_Click()
'すべてのフォントをデフォルトに設定
　　With RichTextBox1
　　　　.SelStart = 0
　　　　.SelLength = Len(.Text)
　　　　.SelFontName = .Font.Name
　　　　.SelFontSize = .Font.Size
　　　　.SelBold = .Font.Bold
　　　　.SelColor = vbBlack
　　　　.SelItalic = .Font.Italic
　　　　.SelUnderline = .Font.Underline
　　　　.SelStrikeThru = .Font.Strikethrough
　　End With
End Sub
　 ５．通常のテキストファイルを保存する
６．リッチテキスト形式のファイルを保存する

Private Sub Command2_Click()
　　'通常のテキストファイルを保存する場合
　　'RichTextBox1.SaveFile "c:\test.txt", rtfText


　　CommonDialog1.Filter = "リッチテキスト形式ファイル|*.rtf"
　　CommonDialog1.ShowSave
　　'リッチテキスト形式のファイルを保存する場合
　　RichTextBox1.SaveFile CommonDialog1.FileName, rtfRTF
End Sub
　 ７．選択箇所のフォント属性を設定する

Private Sub Command3_Click()
　　With RichTextBox1
　　　　CommonDialog1.Flags = cdlCFBoth
　　　　CommonDialog1.ShowFont

　　　　.SelFontName = CommonDialog1.FontName
　　　　.SelFontSize = CommonDialog1.FontSize
　　　　.SelBold = CommonDialog1.FontBold
　　　　.SelItalic = CommonDialog1.FontItalic
　　　　.SelUnderline = CommonDialog1.FontUnderline
　　　　' 必要なものを適時追加して下さい｡
　　　　'CommonDialogを使用せずに直接設定しても OK です
　　End With
End Sub
　 ８．選択箇所のフォントカラーの設定

Private Sub Command4_Click()
　　With RichTextBox1
　　　 ' CommonDialog1.Flags = cdlCFBoth
　　　　CommonDialog1.ShowColor

　　　　.SelColor = CommonDialog1.Color
　　　　'CommonDialogを使用せずに直接設定しても OK です
　　End With
End Sub
　 ９．指定の文字列を検索して指定のカラーで表示する

Private Sub Command5_Click()
　　Dim FindResult As Long
　　Dim FindOption As Long
　　Dim StartPos　 As Long

　　'大文字と小文字を区別して検索
　　FindOption = FindOption Or rtfMatchCase
　　With RichTextBox1
　　　　Do
　　　　　　'検索を実行(見つからなければ -1 が返る)
　　　　　　FindResult = .Find(Text1.Text, StartPos, , FindOption)
　　　　　　If FindResult = -1 Then
　　　　　　　　'カーソルを先頭に移動(選択状態を解除)
　　　　　　　　.SelStart = 0
　　　　　　　　MsgBox "処理を完了しました"
　　　　　　　　Exit Do
　　　　　　Else
　　　　　　　　.SelColor = vbRed　　　 '文字カラーを赤に設定
　　　　　　　　.SelBold = True　　　　 '太字に設定
　　　　　　　　'見つかった文字列の最後から再検索
　　　　　　　　StartPos = LenB(StrConv(Left$(.Text, FindResult) _
　　　　　　　　　　　　　　　　　　　　　　　　& .SelText, vbFromUnicode))
　　　　　　End If
　　　　Loop
　　End With
End Sub
※ 注意
object.Find(string, start, end, options)　での引数 start, end,　の指定はバイト数です。
見つかった位置は文字数だが、次の検索開始位置はバイト数（半角１バイト換算での）で指定の事
（内部でUnicode-Ansi-Unicode-Ansiと変換を行っているからのようです。）
文字数やLenB(.Text)等で指定すると連続しての検索ができません。
(但し、リッチテキスト内がすべて半角文字（１バイト文字）なら別です）
　 10．連続してリッチテキスト内を検索・置き換えする

Private Sub Command6_Click()
　　Dim FindResult As Long
　　Dim FindOption As Long
　　Dim StartPos　 As Long
　　Dim MsgResult　As Integer
　　'大文字と小文字を区別して検索
　　FindOption = FindOption Or rtfMatchCase
　　With RichTextBox1
　　　　Do
　　　　　　'検索を実行(見つからなければ -1 が返る)
　　　　　　FindResult = .Find(Text1.Text, StartPos, , FindOption)
　　　　　　If FindResult = -1 Then
　　　　　　　　'カーソルを先頭に移動(選択状態を解除)
　　　　　　　　.SelStart = 0
　　　　　　　　MsgBox "処理を完了しました"
　　　　　　　　Exit Do
　　　　　　Else
　　　　　　　　.HideSelection = False
　　　　　　　　MsgResult = MsgBox("置き換えますか?", vbYesNo)
　　　　　　　　'検索文字を置き換える場合
　　　　　　　　If MsgResult = vbYes Then
　　　　　　　　　　.SelText = Text2.Text
　　　　　　　　End If
　　　　　　　　.HideSelection = True
　　　　　　　　'見つかった文字列の最後から再検索
　　　　　　　　'次の検索開始位置は半角１バイト換算でのバイト数で指定の事
　　　　　　　　StartPos = LenB(StrConv(Left$(.Text, FindResult) _
　　　　　　　　　　　　　　　　　　　　　　　　& .SelText, vbFromUnicode))
　　　　　　End If
　　　　Loop
　　End With
End Sub

上記　 ※ 注意　を参照
　 11．リッチテキストを印刷

Private Sub Command7_Click()
　　With CommonDialog1
　　　　.Flags = cdlPDReturnDC
　　　　.ShowPrinter
　　　　'キャンセルが押されたら設定しない
　　　　If Err.Number Then
　　　　　　Err.Clear
　　　　　　Exit Sub
　　　　End If
　　　　'書式付きテキストを印刷デバイスに送信
　　　　RichTextBox1.SelPrint (.hDC)
　　End With
End Sub
　 12．先頭行を削除

Private Sub Command8_Click()
'先頭行を削除
　　Dim EndPos As Long
　　With RichTextBox1
　　　　If Len(.Text) > 0 Then
　　　　　　EndPos = InStr(.Text, vbCrLf)
　　　　　　If EndPos = 0 Then
　　　　　　　　.Text = ""
　　　　　　Else
　　　　　　　　.Text = Right$(.Text, Len(.Text) - (EndPos + 1))
　　　　　　End If
　　　　End If
　　End With
End Sub
　 13．最終行を削除

Private Sub Command9_Click()
'最終行を削除
　　Dim EndPos As Long
　　With RichTextBox1
　　　　EndPos = InStrRev(.Text, vbCrLf)
　　　　.Text = Left$(.Text, EndPos)
　　End With
End Sub
リッチテキストボックスは､内部でUnicode -Ansi - Unicode - Ansiと変換を行っているようです｡
従って文字列長等を扱う処理はファイルサイズが大きくなる程､処理速度が遅くなります｡
大きなファイルサイズを扱う場合や処理速度に拘る場合は､APIでの処理を併用するなり、APIだけで処理するようにして下さい。

ここでのサンプルは、初心者の方に解りやすくと言う事と小さなファイルサイズしか扱わない場合のためにあえて、API関数を使わずに作って見ました。









2005/03/28