タブ式テキストエディタ(3)　リッチテキストクラスを修正する

　部品をある程度配置してきましたが、まだ文書を入力できる状態にはなっていません。新規作成やファイルをロードした時には、まずTabPageのインスタンスを新たにつくります。このTabPageの上に、これも新たにTextBoxのインスタンスを新たにつくって配置します。最後にTabPageをフォームのTabControl上に追加します。
　ところで、｢綴り帖」では、RichTextBoxをTextBoxの代わりに使うことにします。リッチテキスト特有の機能（フォントや色を部分的に変えたりする）を使うわけではないのですが、TextBoxは行間がなくて見にくいです。RichTextBoxであれば行間が空いているのでかなり見やすくなります。
　ところがこのRichTextBoxが曲者です。IMEのオンとオフで表示されるフォントが違うのです。しかもオフの状態の時のフォントの変更の仕方が分かりません。原因はDualFont機能がかかっていることにあるようです。RichTextBoxを導入する際はこのDualFontをはずした方が良さそうです。
　さらに問題があります。Textプロパティを取得するとアンドゥのデータが消えてしまうらしく、"元に戻す"が利かなくなります。Lineプロパティでもだめです。例えば、編集メニューの"すべて選択"の使用可/不可を切り替える際には、Textプロパティを取得して文章が存在するかどうかを確かめる方法がとられます。しかし、RichTextBoxでこれをやると、アンドゥができなくなってしまいます。何とかWin32APIを使ってこの問題を回避したいと思います。
　さらにさらに、TextBoxにある編集のポップアップメニューがRichTextBoxにはないようです。これも自作しなければなりません。
　このように、RichTextBoxはそのままでは不便なので、派生クラスをつくって対応することにします。どうせですから、前章で設定したメニューにも一部対応できるように、行の移動、タブストップの変更、ドラッグドロップといった機能も付加したいと思います。長々となりがちなメインフォームのコード量も少しは減るでしょう。
ExpandedTextBox

RichTextBox派生クラス

　まずはネーミング。"ExpandedTextBox"とでもしておきます。ちょっと長ったらしいかもしれません。ネーミングにはいつも悩みます。

Public Class ExpandedTextControl
    Inherits System.Windows.Forms.RichTextBox
    ...　
    ...
End Class

変数の宣言

　下記が変数の宣言です。m_pathnameは読み込んでいるファイル名を格納する内部変数です。PathNameプロパティに反映されます。m_tabwidthはタブ幅の値です。これもプロパティはTabWidthで別に宣言して外部からアクセスできるようにしています。セオリー通り、内部変数とプロパティを分けて設定しました。
　後はポップアップメニューです。動的に配置するようにしています。デザイン画面で設計した方が簡単なのでしょうが、もりじょうにはこの方が楽だったりします。これらは、すべてWithEvensで宣言していません。別にContextMenuClickerというEventHandlerを宣言してClickイベントを結び付けています。こうすると一つの関数内ですべてのメニューのイベントを楽に処理することができます。ここでは"ContextMenu_Click"がそれに当たります。このページの後ろの方に出てきます。
　最後の二行はイベント宣言です。Drag&Dropイベントを独自に設定したいのですが、これらはProtectedイベントにしかなく外部に公開できないためです。

' 変数
Private m_pathname As String = ""
Private m_tabwidth As Integer = 0

Private ContextMenuClicker As _
            New EventHandler(AddressOf ContextMenu_Click)
Private WithEvents m_popup As New ContextMenu()
Private m_undo As New MenuItem("元に戻す(&U)", ContextMenuClicker)
Private m_cut As New MenuItem("切り取り(&T)", ContextMenuClicker)
Private m_copy As New MenuItem("コピー(&C)", ContextMenuClicker)
Private m_paste As New MenuItem("貼り付け(&P)", ContextMenuClicker)
Private m_delete As New MenuItem("削除(&D)", ContextMenuClicker)
Private m_select As New MenuItem("すべて選択(&A)", ContextMenuClicker)
Private m_split1 As New MenuItem("-")
Private m_split2 As New MenuItem("-")
   
' プロパティ : PathName
Public Property PathName() As String
    Get
        Return m_pathname
    End Get
    Set(ByVal Value As String)
        m_pathname = Value
    End Set
End Property

' プロパティ : TabWidth
Public ReadOnly Property TabWidth() As Integer
    Get
        Return m_tabwidth
    End Get
End Property

' イベント
Public Event OnFileDrop(ByVal e As DragEventArgs)

Win32API

　Win32APIを使用する旨の宣言をする必要があります。メッセージ定数の定義もあわせて必要です。SendMessage関数は複数宣言してあります。引数の部分のデータ型や代入方法(ByVal/ByRef)が微妙に違ったりしています。IntPtr型はその変数のアドレスの位置を表す特殊な型です。ポインタはVBではほとんど使いませんが、Cでは必須項目です。ShellExecute...、で始まる関数と構造体はウインドウズの"ファイルのプロパティ"ダイアログを開くのに使います。

' 定数(Win32API)
Private Const IMF_DUALFONT As Integer = &H80
Private Const WM_USER As Integer = &H400
Private Const EM_SETLANGOPTIONS As Integer = WM_USER + 120
Private Const EM_GETLANGOPTIONS As Integer = WM_USER + 121
Private Const EM_FORMATRANGE As Integer = WM_USER + 57
Private Const EM_GETLINECOUNT As Integer = &HBA
Private Const EM_LINELENGTH As Integer = &HC1
Private Const EM_LINEINDEX As Integer = &HBB
Private Const EM_LINEFROMCHAR As Integer = &HC9
Private Const EM_SETTABSTOPS As Integer = &HCB
Private Const SEE_MASK_INVOKEIDLIST As Integer = &HC

' Win32API 関数
Private Declare Function SendMessage Lib "user32.dll" _
    Alias "SendMessageA" _
    (ByVal hWnd As IntPtr, _
     ByVal Msg As Integer, _
     ByVal wParam As Integer, _
     ByVal lParam As Integer) As Integer

Private Declare Function SendMessage Lib "user32.dll" _
    Alias "SendMessageA" _
    (ByVal hWnd As IntPtr, _
     ByVal Msg As Integer, _
     ByVal wParam As Integer, _
     ByRef lParam As Short) As Boolean

Private Declare Function SendMessage Lib "user32.dll" _
    Alias "SendMessageA" _
    (ByVal hWnd As IntPtr, _
     ByVal msg As Integer, _
     ByVal wParam As IntPtr, _
     ByVal lParam As IntPtr) As IntPtr

Private Declare Function ShellExecuteEx Lib "shell32.dll" _
    Alias "ShellExecuteExA" _
    (ByRef lpExecInfo As ShellExecuteInfo) As Integer
 
' 構造体 : ShellExecuteInfo(Win32API)
Private Structure ShellExecuteInfo
    Dim cbSize As Integer
    Dim fMask As Integer
    Dim hWnd As IntPtr
    Dim lpVerb As String
    Dim lpFile As String
    Dim lpParameters As String
    Dim lpDirectory As String
    Dim nShow As Integer
    Dim hInstApp As IntPtr
    Dim lpIDList As Integer
    Dim lpClass As String
    Dim hkeyClass As IntPtr
    Dim dwHotKey As Integer
    Dim hIcon As IntPtr
    Dim hProcess As IntPtr
End Structure

コンストラクタ

　デザイナを使ってませんので、プロパティの初期化をコーディングしています。言語オプションの設定のところですが、まず言語オプション(LangOption)の現在の状態を取得、"DualFont"を解除した値を取得、言語オプションを更新、という手順になっています。"Xor"のくだりはビット演算ですね。私はこれに慣れるのに大変でした。

' コンストラクタ
Public Sub New()
    MyBase.New()
    ' プロパティの設定
    Me.BorderStyle = BorderStyle.None
    Me.AcceptsTab = True
    Me.AllowDrop = True
    Me.HideSelection = False

    ' 言語オプションの設定
    Dim nLangOptions As Integer = 0
    SendMessage(Me.Handle, EM_GETLANGOPTIONS, 0, nLangOptions)
    nLangOptions = nLangOptions Xor IMF_DUALFONT
    SendMessage(Me.Handle, EM_SETLANGOPTIONS, 0, nLangOptions)

    ' コンテキストメニューの追加
    m_popup.MenuItems.AddRange( New MenuItem() _
        { m_undo, m_split1, m_cut, m_copy, _
          m_paste, m_delete, m_split2, m_select} )
    Me.ContextMenu = m_popup
End Sub

ドラッグ&ドロップ

　OnDragEnterイベントではファイルのみ受け付けるようにしています。OnDragDropイベントで新たに定義したOnFileDropイベントを発生させています。

' ドラッグの受け入れ
Protected Overrides Sub OnDragEnter( _
        ByVal drgevent As System.Windows.Forms.DragEventArgs)
    If drgevent.Data.GetDataPresent(DataFormats.FileDrop) Then
        drgevent.Effect = DragDropEffects.All
    End If
    MyBase.OnDragEnter(drgevent)
End Sub

' ドラッグドロップ
Protected Overrides Sub OnDragDrop( _
        ByVal drgevent As System.Windows.Forms.DragEventArgs)
    MyBase.OnDragDrop(drgevent)
    RaiseEvent OnFileDrop(drgevent)
End Sub

行データ、文字データの取得

　Win32APIを経由してデータを取得するための関数群です。既存のメソッドに同じ機能を持つものがあるような気もします。

' GetLineCount : 行数の取得
Public Function GetLineCount() As Integer
    Return SendMessage(Me.Handle, EM_GETLINECOUNT, 0, 0)
End Function

' GetLineLength : 指定された文字がある行の長さの取得
Public Function GetLineLength(ByVal CharIndex As Integer) As Integer
    Return SendMessage(Me.Handle, EM_LINELENGTH, CharIndex, 0)
End Function

' GetCharIndex : 指定された行の先頭文字のインデックスを取得
Public Function GetCharIndex(ByVal LineIndex As Integer) As Integer
    Return SendMessage(Me.Handle, EM_LINEINDEX, LineIndex, 0)
End Function

' GetLineIndex : 指定された文字の位置から行インデックスを取得
Public Function GetLineIndex(ByVal CharIndex As Integer) As Integer
    Return SendMessage(Me.Handle, EM_LINEFROMCHAR, CharIndex, 0)
End Function

メインメニューに対応する機能

　"ワードラップ"メニュー、"タブ幅"メニュー、"ジャンプ"メニュー、"プロパティ"メニューに対応する機能をコーディングします。SetWordWrap関数の引数IsWordWrapはメインフォーム側のコーディングで設定されます。わざわざModifiedプロパティの現状態を記憶して戻しています。WordWrapプロパティを操作するとModifiedプロパティがTrueになってしまうからです。リッチテキスト独自の機能を排除するための処理です。
　タブストップのところで、タブ幅の指定は別途ダイアログで行ないます。ダイアログで指定した値が"PixelValue"に渡されることになります。デフォルトは8。実はこの単位はメモ帳などとは異なり、やや狭いと思います。ダイアログ単位なるものが絡んでいるようで、さらにこの単位はダイアログで使用するフォントサイズに影響されるようです。私の理解不足かもしれませんが、ダイアログ単位を取得する方法が面倒くさそうだったのでデフォルト値のままにしてしまっています。

' SetWordWrap : ワードラップの設定
Public Sub SetWordWrap(ByVal IsWordwrap As Boolean)
    Dim bModified As Boolean = Me.Modified
    Me.WordWrap = IsWordwrap
    Me.Modified = bModified
End Sub

' SetTabStops : タブストップの設定
Public Sub SetTabStops(ByVal PixelValue As Integer)
    If PixelValue <> m_tabwidth Then
        ' 選択文字列の位置を記憶
        Dim nStart As Integer = Me.SelectionStart
        Dim nLength As Integer = Me.SelectionLength
        ' タブ幅を算出して適用
        Dim nTabwidth As Short = CShort(PixelValue * 4)
        Dim bReturn As Boolean
        If PixelValue = 0 Then
            ' デフォルト値
            bReturn = _
                SendMessage(Me.Handle, EM_SETTABSTOPS, 0, nTabwidth)
        Else
            ' 指定値
            bReturn = _
                SendMessage(Me.Handle, EM_SETTABSTOPS, 1, nTabwidth)
        End If
        Me.Refresh()
        ' 復元処理
        Me.Select(nStart, nLength)
        If bReturn Then m_tabwidth = PixelValue
    End If
End Sub

' ScrollToLine : 指定された行へ移動
Public Sub ScrollToLine(ByVal LineIndex As Integer)
    Dim nLines As Integer = Me.GetLineCount()
    If LineIndex <= 1 Then LineIndex = 0
    If LineIndex >= nLines Then LineIndex = nLines - 1
    Dim nChar As Integer = Me.GetCharIndex(LineIndex)
    ' 行の先頭文字にキャレットを移動
    Me.Select(nChar, 0)
    Me.ScrollToCaret()
End Sub

' ShowFileProperty : ファイルのプロパティの表示
Public Sub ShowFileProperty()
    Try
        ' 構造体のメンバを指定
        Dim udtInfo As ShellExecuteInfo
        With udtInfo
            .cbSize = Runtime.InteropServices.Marshal.SizeOf(udtInfo)
            .fMask = SEE_MASK_INVOKEIDLIST
            .hWnd = Me.Handle
            .lpVerb = "properties"
            .lpFile = m_pathname
        End With
        ' プロパティを表示
        Dim nValue As Integer = ShellExecuteEx(udtInfo)
    Catch ex As Exception
        MessageBox.Show(ex.Message, "プロパティ表示エラー", _
            MessageBoxButtons.OK, MessageBoxIcon.Error)
    End Try
End Sub

ポップアップメニューの設定

　Popupイベント発生時に、各メニューのオン/オフを判定しています。問題となっている"Text"プロパティ取得の代わりにLineCountとLineLengthを使って対応しています。Textが空の時は、LineCount=1、LineLength=0となります。この方法だとアンドゥデータが消えないようです。
　ContextMenu_Clickイベントでは、各メニューのクリックイベントを一手に引き受けています。ひとつひとつ"..._Click"イベントを記述するよりもかなりすっきりします。

' ポップアップメニュー : ポップアップ
Private Sub m_popup_Popup(ByVal sender As Object, _
        ByVal e As System.EventArgs) Handles m_popup.Popup
    Dim nLineCount As Integer = Me.GetLineCount
    Dim nLineLength As Integer = Me.GetLineLength(0)
    m_undo.Enabled = Me.CanUndo
    m_cut.Enabled = Not Me.SelectedText.Equals("")
    m_copy.Enabled = Not Me.SelectedText.Equals("")
    m_delete.Enabled = Not Me.SelectedText.Equals("")
    m_select.Enabled = Not (nLineCount + nLineLength).Equals(1)
    m_paste.Enabled = _
        Me.CanPaste(DataFormats.GetFormat(DataFormats.Text)) OrElse _
        Me.CanPaste(DataFormats.GetFormat(DataFormats.Rtf))
End Sub

' ポップアップメニュー : クリックイベント
Private Sub ContextMenu_Click( _
        ByVal sender As Object, ByVal e As EventArgs)
    If sender Is m_undo Then : Me.Undo() : Me.ClearUndo()
    ElseIf sender Is m_cut Then : Me.Cut()
    ElseIf sender Is m_copy Then : Me.Copy()
    ElseIf sender Is m_paste Then : Me.Paste()
    ElseIf sender Is m_delete Then : Me.SelectedText = ""
    ElseIf sender Is m_select Then : Me.SelectAll()
    End If
End Sub
| ■HOME | ◆プログラムTop | ▲ページの先頭 | << 前の章 | 次の章 >> |