前回でコンテキストメニュー関連における問題点であった、テキストボックスモードでフォント情報などをコピー及び貼り付けしないという問題は解決しました。
コードを載せていませんでしたが、いろいろとコードの調整なども実施していますので、コピペすれば問題なく動作するというわけではありませんので、あしからず。
さて本題の前。
整理の中で「SelectedText」プロパティに問題が発生しました。（SelectALL関連で作成したプロパティ）
たとえば、下記のようなコードなら問題ありません。
''' <summary>
''' 現在選択されている文字列を取得します。
''' </summary>
''' <value> </value>
''' <returns></returns>
''' <remarks></remarks>
Public ReadOnly Property SelectedText As String
Get
'文字列の取得
Dim buf As New System.Text.StringBuilder
buf.Length = 32767
'選択されている文字列を取得する。
SendMessage(_Handles.TextBox, EM_GETSELTEXT, 0, buf)
Return buf.ToString
End Get
End Property
しかしこれを
「現在選択されている文字列を取得または設定します。設定する文字列が存在しない場合は何も選択しません。」
とした場合です。
順番としてはまずコードから指定された文字列が存在するかどうかの有無を確認するために、下記のコードを書いたのですが、検索文字列に指定の文字列があるにもかかわらず、「-1」しか返ってこないという現象が発生しました。
''' <summary>
''' 文字列を検索します。検索に成功した場合、最初の文字列の文字位置を返します。見つからなかった場合は-1を返します。
''' </summary>
''' <param name="Value">検索する文字列を指定します。</param>
''' <param name="Mode">現在の選択位置から検索するかどうかを指定します。現在の選択位置から検索する場合はTure,しない場合はFalseをしてします。</param>
''' <param name="MATCHCASE">指定された文字列と一致する単語のみを検索する場合はTrue、そうでない場合はFalseを指定します。</param>
''' <param name="WHOLEWORD">大文字・小文字を区別して検索する場合はTrue、しない場合はFalseを指定します。</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Find(ByVal value As String, Optional ByVal Mode As Boolean = False, Optional ByVal MATCHCASE As Boolean = False, Optional ByVal WHOLEWORD As Boolean = False) As Integer
If value.Length = 0 Then Return -1
Dim F As New FINDTEXTEX
F.lpstrText = value
'検索範囲を指定する場合は指定します。
F.chrg.cpMin = 0
F.chrg.cpMax = SendMessage(_Handles.TextBox, WM_GETTEXTLENGTH, 0, 0)
Dim wParam As IntPtr = fuFlags.FR_DOWN
If Mode Then wParam += fuFlags.FR_DOWN
If MATCHCASE Then wParam += fuFlags.FR_MATCHCASE
If WHOLEWORD Then wParam += fuFlags.FR_WHOLEWORD
Dim SC As Integer = SendMessage(_Handles.TextBox, EM_FINDTEXTEX, wParam, F)
Return SC
End Function
いろいろ調べてみましたが原因が不明なので、下記の通り修正
''' <summary>
''' 文字列を検索します。検索に成功した場合、最初の文字列の文字位置を返します。見つからなかった場合は-1を返します。
''' </summary>
''' <param name="Value">検索する文字列を指定します。</param>
''' <param name="Mode">現在の選択位置から検索するかどうかを指定します。現在の選択位置から検索する場合はTure,しない場合はFalseをしてします。</param>
''' <param name="MATCHCASE">指定された文字列と一致する単語のみを検索する場合はTrue、そうでない場合はFalseを指定します。そうでない場合は、半角、全角、ひらがなの区別をしません。</param>
''' <param name="WHOLEWORD">大文字・小文字を区別して検索する場合はTrue、しない場合はFalseを指定します。</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Find(ByVal value As String, Optional ByVal Mode As Boolean = True, Optional ByVal MATCHCASE As Boolean = False, Optional ByVal WHOLEWORD As Boolean = False) As Integer
If value.Length = 0 Then Return -1
Dim StartIndex As Integer = 0
Dim temp As String = Text
temp = temp.Replace(vbCrLf, vbCr)
If Mode Then
Dim lpchr As CHARRANGE
SendMessageA(_Handles.TextBox, EM_GETSEL, lpchr.cpMin, lpchr.cpMax)
If lpchr.cpMax <> lpchr.cpMin Then StartIndex = lpchr.cpMax
End If
If MATCHCASE Then '一致する文字列のみ検索する。
If WHOLEWORD Then '大文字、小文字の区別をつける。
Return temp.IndexOf(value, StartIndex) - StartIndex
Else
Return temp.IndexOf(value, StartIndex, StringComparison.OrdinalIgnoreCase) - StartIndex
End If
Else
Dim _MC As System.Globalization.CompareInfo = System.Globalization.CultureInfo.CurrentCulture.CompareInfo
Dim index As Integer = _MC.IndexOf(temp, value, StartIndex, Globalization.CompareOptions.IgnoreWidth)
If index = -1 Then _MC.IndexOf(temp, value, StartIndex, Globalization.CompareOptions.IgnoreKanaType)
If index = -1 AndAlso WHOLEWORD = False Then
index = _MC.IndexOf(temp, value, StartIndex, Globalization.CompareOptions.IgnoreCase)
End If
Return index
End If
End Function
いったんテキストボックスの文字列を変数に格納して、変数から検索する方法です。
動作的にはこれで問題はなくなったのですが、「EM_FINDTEXT」が使用できなかった問題を棚上げしたのは、なんかすっきりしない。
（とはいえ、こっちの方がカナや半角、全角の種別なく検索かけることができるので、機能的には上なんですが）
整理の話は以上。（細かいバグを発見したらその都度修正）
今回は読み込み専用です。
| プロパティ名 | 説明 |
| Enabled | コントロールの読み込み専用の設定。 |
最初、ユーザーコントロールの方に依存する形を考えました。しかしその場合、従来のボックスでは読み込み専用時でも文字列は選択できますが、依存してしまうとそれすらできなくなるという問題があります。
そのため、今回はユーザーコントロールに依存する形ではなく、縦書ボックスの方をきちんと設定してやる必要があります。
''' <summary>
''' 有効、無効状態の識別用
''' </summary>
''' <remarks></remarks>
Private _Enabled As Boolean = False
''' <summary>
''' 縦書きテキストボックスの有効または無効状態を取得、設定します。
''' </summary>
''' <value>有効の場合はTrue,無効の場合はFalse</value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Enabled As Boolean
Get
Return _Enabled
End Get
Set(value As Boolean)
Dim c As IntPtr = SendMessage(_Handles.TextBox, EM_SETREADONLY, value, 0)
If c = 0 Then
Debug.Print("Enable:err " & value.ToString & "=" & c.ToString)
End If
_Enabled = value
End Set
End Property
コード自体はこのように簡単なのですが、問題なのが読み込み専用設定したところで、何も色が変化しない点があります。
こんな感じで、読み込み専用でも文字列の選択はできます。
さて、この時に問題になるのが二点発見。
一点目はコンテキストメニューです。
実際、切り取りや貼り付け、削除を押しても読み取り専用になっている関係か操作自体は問題ありません。
とはいえ、選択できるという状況は問題ですので修正してやる必要があります。
修正対象はコンテキストメニューの「Opened」イベント。
現在のコード
''' <summary>
''' ドロップダウンが開いたときに発生
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub _Opened(sender As Object, e As System.EventArgs) Handles AutoVerbMenuSplit.Opened
For Each i As ToolStripItem In AutoVerbMenuSplit.Items
Select Case True
Case TypeOf i Is ToolStripMenuItem
Select Case i.Text
Case "元に戻す(&U)"
If SendMessage(_Handles.TextBox, EM_CANUNDO, 0, 0) <> 0 Then
i.Enabled = True
Else
i.Enabled = False
End If
Case "やり直す(&R)"
If SendMessage(_Handles.TextBox, EM_CANREDO, 0, 0) <> 0 Then
i.Enabled = True
Else
i.Enabled = False
End If
Case "切り取り(&T)", "コピー(&C)", "削除(&D)"
'文字列が選択されているかどうか、選択状況を調べます。
Dim c As CHARRANGE
SendMessageA(_Handles.TextBox, EM_GETSEL, c.cpMin, c.cpMax)
If c.cpMax = c.cpMin Then
i.Enabled = False
Else
i.Enabled = True
End If
Case "貼り付け(&P)"
If SendMessage(_Handles.TextBox, EM_CANPASTE, 0, 0) <> 0 Then
i.Enabled = True
Else
i.Enabled = False
End If
Case "すべて選択(&A)"
Dim _LENGTH As Integer = SendMessage(_Handles.TextBox, WM_GETTEXTLENGTH, 0, 0)
If _LENGTH > 0 Then
i.Enabled = True
Else
i.Enabled = False
End If
End Select
End Select
Next
End Sub
これらのコードを
''' <summary>
''' ドロップダウンが開いたときに発生
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub _Opened(sender As Object, e As System.EventArgs) Handles AutoVerbMenuSplit.Opened
Dim Flag As Boolean = Enabled
For Each i As ToolStripItem In AutoVerbMenuSplit.Items
Select Case True
Case TypeOf i Is ToolStripMenuItem
Select Case i.Text
Case "元に戻す(&U)", "やり直す(&R)", "切り取り(&T)", "削除(&D)", "貼り付け(&P)"
If Flag Then
i.Enabled = False
Else
Select Case i.Text
Case "元に戻す(&U)"
If SendMessage(_Handles.TextBox, EM_CANUNDO, 0, 0) <> 0 Then
i.Enabled = True
Else
i.Enabled = False
End If
Case "やり直す(&R)"
If SendMessage(_Handles.TextBox, EM_CANREDO, 0, 0) <> 0 Then
i.Enabled = True
Else
i.Enabled = False
End If
Case "切り取り(&T)", "削除(&D)"
Call ContextCutCopyDeleteEnable(i)
Case "貼り付け(&P)"
If SendMessage(_Handles.TextBox, EM_CANPASTE, 0, 0) <> 0 Then
i.Enabled = True
Else
i.Enabled = False
End If
End Select
End If
Case "コピー(&C)"
Call ContextCutCopyDeleteEnable(i)
Case "すべて選択(&A)"
Dim _LENGTH As Integer = SendMessage(_Handles.TextBox, WM_GETTEXTLENGTH, 0, 0)
If _LENGTH > 0 Then
i.Enabled = True
Else
i.Enabled = False
End If
End Select
End Select
Next
End Sub
''' <summary>
''' コンテキストメニューの切り取り、コピー、削除の有効無効操作用プロシージャ
''' </summary>
''' <param name="Value">操作するボタンコントロール</param>
''' <remarks></remarks>
Private Sub ContextCutCopyDeleteEnable(ByRef Value As ToolStripMenuItem)
'文字列が選択されているかどうか、選択状況を調べます。
Dim c As CHARRANGE
SendMessageA(_Handles.TextBox, EM_GETSEL, c.cpMin, c.cpMax)
If c.cpMax = c.cpMin Then
Value.Enabled = False
Else
Value.Enabled = True
End If
End Sub
上記のように変更することで何とかなりました。とはいえ、もっとスムーズなコードがありそうな気もしますが(苦笑)
（そもそも「Opened」では、「切り取り」「コピー」「削除」の判定有無の基準は同じなんだから、三回も「ContextCutCopyDeleteEnable」を呼び出す必要はなく、1回目の情報を変数に格納してその変数で判定すればいい。なので実際のコードはそのように修正しました）
さて、ここで再び問題が発生。と間違い発見。間違いは切り取りはCtrl+TではなくCtrl+Xでした。上記コード及びコンテキストメニュー作成時の割り振り等を修正します。また、元に戻すもCtrl+Uを設定するとCtrl+Zでも反応するので併せて修正。
問題はキーボードによるショートカット処理です。
キーイベントをユーザーコントロールの方で拾っている関係で、貼り付け処理だけは実行してしまっています。合わせてこれも修正が必要です。
なのでユーザーコントロール側も
''' <summary>
''' ショートカット制御用 Ctrl+C及びctrl+Vの無効及びコピー、貼り付け処理の実施
''' </summary>
''' <param name="msg"></param>
''' <param name="keyData"></param>
''' <returns></returns>
''' <remarks></remarks>
Protected Overrides Function ProcessCmdKey(ByRef msg As System.Windows.Forms.Message, keyData As System.Windows.Forms.Keys) As Boolean
If (keyData And Keys.Control) = Keys.Control AndAlso MeControl IsNot Nothing AndAlso RichMode = False Then
Select Case (keyData And Keys.KeyCode)
Case Keys.V
If Enabled = False Then
Call Module_Paste.Paste()
Return True
End If
Case Keys.C
Call Module_Copy.Copy()
Return True
End Select
End If
Return MyBase.ProcessCmdKey(msg, keyData)
End Function
このように修正してやりました。
で、このタイミングで間違いを発見。
過去のソースで貼り付けの宣言（テキストボックスモードで）にて
「SendMessage(_Handles.TextBox, EM_REPLACESEL, 0, New System.Text.StringBuilder(str))」
このように宣言していました。
wParamに「０」を設定していますがこれが誤りで「１」になります。
「０」に設定してしまいと「元に戻す」ための履歴をテキストボックスが保有しないためです。
次に発生した問題は、元に戻した場合です。
IMEなど日本語入力を有効にしている場合はいいのですが、そうでない場合
このように連続して入力した後に「元に戻す」をすると
一気にここまで戻ってしまう現象が起こっています。
一文字ずつ戻らないのです。どうやら、フォーカスを失うまで一連の流れを一つの履歴としてカウントしているかな？
（日本語入力モードの場合、変換後のENTERを押すまでフォーカスはIEMが一旦移動している感じなのでしょう）
仕方がないので、キーイベント（KEYDOWN）毎にフォーカスをいったん親コントロール（ユーザーコントロールではない）に預けてすぐに戻すというふうにしました。
（一応、これで「元に戻す」で一文字ずつもどるようになりました）
''' <summary>
''' 方向キーを縦型に対応させるための関数
''' </summary>
''' <param name="uMsg">メッセージ</param>
''' <param name="wParam">パラメータ</param>
''' <returns>True:方向キーの変更を実施 False:方向キーの変更を未実施</returns>
''' <remarks></remarks>
Private Function KeyCheck(ByVal uMsg As IntPtr, ByRef wParam As IntPtr) As Boolean
If uMsg = WM_KEYUP Or uMsg = WM_KEYDOWN Then
Select Case wParam
Case Windows.Forms.Keys.Up
wParam = Windows.Forms.Keys.Left
Case Windows.Forms.Keys.Down
wParam = Windows.Forms.Keys.Right
Case Windows.Forms.Keys.Left
wParam = Windows.Forms.Keys.Down
Case Windows.Forms.Keys.Right
wParam = Windows.Forms.Keys.Up
Case Windows.Forms.Keys.Tab
If MeControl.TabStop = False Then
wParam = Windows.Forms.Keys.Tab
End If
Case Else
Dim key As Windows.Forms.Keys = wParam
If uMsg = WM_KEYDOWN Then
SetFocus(_Handles.Parent) ‘←これを追加 親ウインドウにフォーカスを移動
Debug.Print("KeyUP:" & key.ToString) ‘←これを追加 キー判定確認用
SetFocus(_Handles.UserControl) ‘←これを追加 自分にフォーカスを移動
End If
Return False
End Select
Return True
Else
Return False
End If
End Function
見た目上の動作は問題ないのですが、なんか正式なやり方じゃないんだろうなぁ、、、これが原因でどこかで不具合が発生するのは嫌だなぁと思うこのごろです。
（あまりにキータイプの速度が速くてSetFocusエラーが発生しそうなら、間にDoEventsでも呼び出した方がいいのかも？）
最後に背景色です。
背景色の切り替えを行うということなので、まずは「BackColor」プロパティを作成し、そのあと切り替え時に背景色をシステムカラーあたりを指定してやればいいかなと考慮します。
| プロパティ名 | 説明 |
| BackColor | コンポーネントの背景色です。 |
''' <summary>
''' 背景色を設定します。
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property BackColor As System.Drawing.Color
Get
If MeControl Is Nothing Then Return Nothing
Return MeControl.BackColor
End Get
Set(value As System.Drawing.Color)
If MeControl IsNot Nothing AndAlso ColorTranslator.ToWin32(MeControl.BackColor) <> ColorTranslator.ToWin32(value) Then
MeControl.BackColor = value
End If
'コントロールの入力制限が有効の場合はシステム色のままにします。無効の場合は指定された背景色に設定します。
If Enabled = False Then
SendMessage(_Handles.TextBox, EM_SETBKGNDCOLOR, 0, ColorTranslator.ToWin32(value))
End If
End Set
End Property
''' <summary>
''' 有効、無効状態の識別用
''' </summary>
''' <remarks></remarks>
Private _Enabled As Boolean = False
''' <summary>
''' 縦書きテキストボックスの有効または無効状態を取得、設定します。
''' </summary>
''' <value>有効の場合はTrue,無効の場合はFalse</value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Enabled As Boolean
Get
Return _Enabled
End Get
Set(value As Boolean)
If _Handles.TextBox = IntPtr.Zero Then Exit Property
Dim c As IntPtr = SendMessage(_Handles.TextBox, EM_SETREADONLY, value, 0)
If c = 0 Then
Debug.Print("Enable:err " & value.ToString & "=" & CBool(c).ToString & " /Handle:" & _Handles.TextBox.ToString)
End If
_Enabled = value
If _Enabled Then
Dim GrayColor As Color = SystemColors.Control
Dim GrayIntPtr As Integer = ColorTranslator.ToWin32(GrayColor)
SendMessage(_Handles.TextBox, EM_SETBKGNDCOLOR, 0, GrayIntPtr)
Else
BackColor = MeControl.BackColor
End If
End Set
End Property
コントロールの方
''' <summary>
''' 背景色を設定します。
''' </summary>
''' <value>設定する背景色</value>
''' <returns></returns>
''' <remarks></remarks>
Public Overrides Property BackColor As System.Drawing.Color
Get
Return MyBase.BackColor
End Get
Set(value As System.Drawing.Color)
MyBase.BackColor = value
Module_BackColor.BackColor = value
End Set
End Property
こんな感じ。
「EM_SETBKGNDCOLOR」のlParamは「0x00BBGGRR」ですので、toARGBではNGとなります。
そのため、Windowsカラーを指定してくれるColorTranslator.ToWin32を使用しました。
背景色はEnabledを優先。
0 件のコメント:
コメントを投稿