VB.netのリッチテキストボックスでキャレットの幅を変更する方法

前へ 次へ
このQ&Aのポイント
  • VB.netのリッチテキストボックスでキャレットの幅を変更する方法について調査しました。リッチテキストボックスにフォーカスが当たった時にキャレットの幅を変える処理を行いましたが、一度だけフォーカスが当たった時に一瞬だけ四角いキャレットが表示された後、すぐにＩ型に戻ってしまいました。
  • 現在の実装では、CreateCaret関数を使用してキャレットを作成し、ShowCaret関数でキャレットを表示しています。しかし、この方法ではうまくキャレットの幅を変更することができませんでした。
  • この問題について、他の解決策やヒントをご存知の方がいらっしゃいましたら、教えていただけると助かります。どうぞよろしくお願い致します。
回答を見る
  • ベストアンサー

VB.net キャレットの幅の変更をしたい

OS:Windows 7 64bit 開発環境：Visual Studio 2013 Express リッチテキストボックスでキャレットの幅を変更したいのですが、うまくいきません。 ------------------------------------------------------------- 'キャレットを作成する Private Declare Function CreateCaret Lib "user32" _ (ByVal hWnd As IntPtr, _ ByVal hBitmap As IntPtr, _ ByVal nWidth As Integer, _ ByVal nHeight As Integer _ ) As Boolean 'キャレットを表示する Private Declare Function ShowCaret Lib "user32" _ (ByVal hWnd As IntPtr) As Boolean Private Sub RichTextBox1_Enter(sender As Object, e As EventArgs) Handles RichTextBox1.Enter 'CreateCaret(RichTextBox1.Handle, IntPtr.Zero, 7, 15) CreateSolidCaret(5, 10) ShowCaret(RichTextBox1.Handle) End Sub ------------------------------------------------------------- 以上のようにして RichTextBox1 にフォーカスが来た時にキャレットの幅を変えるようにしているのですが、一度だけフォーカスが来た時にほんの一瞬だけ四角いキャレットが見えるのですが、すぐにＩ型に戻ってしまいます。 ググっても上記ソースくらいしか見つかりませんでした。 どなたかご享受願えませんでしょうか？ よろしくお願い致します。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

プロシージャを抜けると作成されたキャレットが破棄されるように仕様が変更されたようで RichTextBox1_Enter イベントで作成するとすぐにRichTextBox1_GotFocus イベントが発生し その時点で破棄されるので、一瞬しか確認できないのです。 どうしてもなら、RichTextBox1_GotFocus イベントで作成すると次のイベントが発生するまでは 破棄されませんので表示されるようになります。 但しキー入力やマウスダウンイベントが発生すると破棄されるので、キーアップイベントと マウスアップイベントにも書いておく必要があります。 (ダウン イベント書くと直後にアップ イベントが発生するのですぐに破棄される事になり表示されません) テキストボックスとRichTextBox とその辺の仕様が違う理由については、よく知りません(調べていない)

Raio77
質問者

お礼

ありがとうございます。 テストした結果、vbhanatyanさんの仰るとおりのようです。 今回はキャレットの変更は諦めます＾＾； それにしても、なんでこんな仕様に変更したのか・・・

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • SendMessageによるチェックボックスの状態取得

    はじめまして、VB.NET2005でチェックボックスの状態の取得、設定をうまく設定できません。OSはxpです。 Public Class Form1 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" 　(ByVal lpClassName As String, _ ByVal lpWindowName As String) As Integer Private Declare Function FindWindowEx Lib "user32"　Alias "FindWindowExA" (ByVal hWnd1 As Integer, _ ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, _ ByVal wMsg As Integer, ByVal wParam As Integer, ByVal iParam As String) As Integer Private Declare Function SendMessageint Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, _ ByVal wMsg As Integer, ByVal wParam As Integer, ByVal iParam As Integer) As Integer Const BM_GETCHECK = &HF0 Const BM_GETSTATE = &HF2 Const BM_SETCHECK = &HF1 Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim hWindows As Integer Dim ipEDIT As Integer Dim i As Integer hWindows = FindWindow(vbNullString, "Form1") '198458 ipEDIT = FindWindowEx(hWindows, 0, vbNullString, "CheckBox1") MessageBox.Show(ipEDIT) i = SendMessageint(ipEDIT, BM_GETCHECK, 0, 0) 'SendMessageint(ipEDIT, BM_SETCHECK, 1, 0) MessageBox.Show(i) End Sub End Class のようなコードなのですが、 ハンドルは取得できているのですが、 SendMessageの戻り値は0になります。 勿論、コメントのチェックをセットも出来ません。 ご教授のほど宜しくお願いします。

  • ExcelVBA　Delegate文がエラーになる

    Excel2010　VBAでの質問です。 画面上のすべてのトップレベルウィンドウを取り出そうと、標準モジュールに以下コーディングしました。 Option Explicit Declare Function EnumWindows Lib "User32.dll" (ByVal Proc As EnumWinProc, ByVal lParam As Integer) As Boolean Delegate EnumWinProc (ByVal hwnd As IntPtr, ByVal lParam As Integer) As Boolean Sub Main() Call EnumWindows(AddressOf disp_hwnd, 0) MsgBox ("完了") End Sub Function disp_hwnd(ByVal hwnd As IntPtr, ByVal lParam As Integer) As Boolean MsgBox (hwnd) disp_hwnd = True End Function そうしたところ、Delegate 文が赤文字に反転してエラーになります。 Excel2003　VBAでは使えない構文なのでしょうか？あるいは何かのミスなのでしょうか？ 環境ですが、WindowsXP　SP3、Excel2003 SP3です。 .NET Framework1.1、2.0、3.0、4.0がインストールされています。 あと、以下の参照設定はあります。 　　Visual Basic For Applications Microsoft Excel 11.0 Object Library OLE Automation Microsoft Office 11.0 Object Library Microsoft Forms 2.0 Object Library Microsoft Scripting Runtime Microsoft Windows Common Controls 6.0 (SP6) 以上、よろしくお願いします。

  • VB.NETのSendMessageを教えてください

    SendMessageというAPIを試しているのですが、まず試しに Button2.Text = "test" と同じ結果をSendMessageでやってみたいのですが 下のようにしてみたのですが、変更になりませんでした。 どのようにすれば良いかご教授頂ければ幸いです。よろしくお願致します。 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer Private Const WM_SETTEXT As Integer = &HC Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim h As Integer h = Me.Button2.Handle.ToInt32 SendMessage(h, WM_SETTEXT, 0&, "test") End Sub VB.NET2003 FrameWork1.1 WindowsXP-PRO(SP2) です。

  • VBAでSetTextColorがうまくいかない

    EXCELのVBAでユーザーフォームを使ったグラフィック表示のプログラムを 作っているのですが、SetTextColorでテキスト色の設定をしようと してもうまくいきません。何故か設定しようとする色の値が無視されて 「1304008」が設定されてしまいます。(GetTextColorで確認) そしてそれ以降何を設定してもこの状態のままです。 何か考えられることがありますでしょうか。 下にそのプログラムを示します。 ちなみにSetBKColorやAngleArcなど他のグラフィック命令は問題なく 動いていてSetTextColorだけがうまくいってない状態です。 '------------------------------------------------- ' ユーザーフォーム用プログラム '------------------------------------------------- Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, _ ByVal lpszWindow As String) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _ (ByVal hdc&, ByVal x&, _ ByVal y&, ByVal lpString$, ByVal nCount&) As Long Dim hWnd As Long Dim hdc As Long Public Sub UserForm_Activate() DoEvents hWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "") hdc = GetDC(hWnd) ret = SetTextColor(hdc, RGB(255, 0, 0)) ret = TextOut(hdc, 0, 0, "abc", 3) Call ReleaseDC(hWnd, hdc) End Sub '-------------------------------------------------

  • ＶＢ２０１０　ウィンドウタイトルを取得

    こんにちはＶＢ学習を始めて２週間になりました。 Ｗｅｂの記事などを参考にしていますがバージョンによって記述が変わって苦戦しています。 今回ご質問したい内容です。 ボタンを押すとメモ帳が起動されているか調べてそのウィンドウタイトルを得る ウィンドウタイトルで検索してハンドルを取得してそのままそのハンドルで逆に ウィンドウタイトルを得ています（無意味な処理ですが学習用という事で） Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Integer, ByVal lpString As String, ByVal nMaxCount As Integer) As Integer Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim ECHandle As Integer Dim Titlename As String Titlename = vbNullString ECHandle = FindWindow(vbNullString, "無題 - メモ帳") GetWindowText(ECHandle, Titlename, 255) Label5.Text = Titlename If ECHandle = 0 Then Label4.Text = "取得できない" Else Label4.Text = "取得出来た" & ECHandle & Titlename End If End Sub 結果はというと Titlename が空っぽのままでタイトルが取得できません どのような原因が考えられますでしょうか？ よろしくお願いいたします。

  • Formを動かせるようにしたい

    お世話になります。 OS　XP　PRO　　VB6（SP５）で開発しています。 ディスプレイのサイズによりFormを動かせたり固定させたりしたいのですが、 規定値は固定にしたいのでFormプロパティのMoveableはFalseにしてあります。 下記のようにプログラミングしたのですが固定されたままです。 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal _ hwnd As Long _ , ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" ( _ ByVal hMenu As Long, ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" ( _ ByVal hwnd As Long) As Long Private Const MF_BYCOMMAND = &H0 Private Const SC_MOVE = &HF010 Private Sub Form_Load() Dim kk As Long kk = GetSystemMenu(.hwnd, bb) Call RemoveMenu(kk, SC_MOVE, MF_BYCOMMAND) Call DrawMenuBar(.hwnd) End Sub アドバイス頂きたくよろしくお願いします。 以上です。

  • C#で動作するコードをvbに移植したら動作しません

    以下のサイトのC#のサンプルコードを、vbに移植しました。 しかし、正常動作しません。 C#で正常動作するのは、確認しました。 とても悩んでします。 どなたか、教えていただけませんか。 よろしくお願いします。 https://tzeditor.blogspot.com/2020/02/customtitlebar.html 不具合内容は、以下になります。 ・非クライアント領域が緑になりません。白色です。 ・ウィンドウリフレッシュ（※）が動作すると、白色も消え、 　普通のフォームの外観になります。 　※他のウィンドウをアクティブにする。 Imports System.Windows.Forms Imports System.Runtime.InteropServices Public Class Form1 <StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> Public Structure RECT Public Left As Int32 Public Top As Int32 Public Right As Int32 Public Bottom As Int32 Public ReadOnly Property Size As Size Get Return New Size(Right - Left, Bottom - Top) End Get End Property End Structure Declare Function GetWindowDC Lib "user32.dll" (ByVal hWnd As IntPtr) As IntPtr Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As Int32 Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal nLeftRect As Integer, ByVal nTopRect As Integer, ByVal nRightRect As Integer, ByVal nBottomRect As Integer) As IntPtr Declare Function DeleteObject Lib "gdi32.dll" (hObject As IntPtr) As Boolean <System.Security.Permissions.PermissionSetAttribute(System.Security.Permissions.SecurityAction.Demand, Name:="FullTrust")> Protected Overrides Sub WndProc(ByRef m As Message) Const WM_ACTIVATE As Int32 = &H6 Const WM_NCPAINT As Int32 = &H85 Const WM_NCACTIVATE As Int32 = &H86 'Dim handle As HandleRef = New HandleRef(Nothing, m.HWnd) Select Case (m.Msg) Case WM_ACTIVATE Case WM_NCPAINT Case WM_NCACTIVATE '非クライアント領域を含むデバイスコンテキストを取得 Dim hdc As IntPtr = GetWindowDC(m.HWnd) Try ' デバイスコンテキストからGraphicsを生成 ' Regionはクリッピングに使用 Using g As Graphics = Graphics.FromHdc(hdc) Using rgn As Region = New Region() Dim rect As RECT ' ウィンドウサイズを取得 ' Sizeプロパティでは正確な値が取れないので GetWindowRect(m.HWnd, rect) ' コントロールの矩形 Dim clientRect As Rectangle = New Rectangle(Point.Empty, rect.Size) ' 境界線の太さ分収縮した矩形を描画対象から外す rgn.Union(clientRect) rgn.Xor(New Rectangle(8, 31, clientRect.Width - 16, clientRect.Height - 39)) g.Clip = rgn ' タイトルバー領域の塗りつぶし g.FillRectangle(Brushes.Green, clientRect) g.FillEllipse(Brushes.Red, New Rectangle(200, 8, 20, 20)) ' WParamにはクリッピング領域のリージョンハンドルを設定 ' OSによる描画範囲を境界線の太さ分だけ収縮した矩形とする Dim wParam As IntPtr = CreateRectRgn(rect.Left + 8, rect.Top + 31, rect.Right - 8, rect.Bottom - 39) Dim m2 As Message = Message.Create(m.HWnd, m.Msg, wParam, m.LParam) MyBase.WndProc(m2) End Using End Using Catch ' 例外が発生したらOSに描画させる MyBase.WndProc(m) Finally '取得したデバイスコンテキストを解放 ReleaseDC(m.HWnd, hdc) End Try Return Case Else MyBase.WndProc(m) Return End Select End Sub End Class お手数をお掛けします。 よろしくお願いします。

  • VB6のAdressOfをVB.NETに変換したい

    以下のソースをVB.NETに変換したいのですが．．． XOpenDLL関数の AddressOfのあたりがエラーになって変換できません。 （Microsoft Visual Basic .NET 2003の変換機能） Private Declare Function XOpenDLL Lib _ "Maser.dll" _ Alias "OpenDLL" _ (ByVal nModel As Long, _ ByVal nLens As Long, _ ByVal nLensMfr As Long, _ ByVal nGSpeed As Long, _ ByVal nSocketPort As Long, _ ByVal nRS232Port As Long, _ ByVal pCallbackFn As Long) _ As Boolean Private Declare Function XSendCommand Lib _ "Maser.dll" _ Alias "SendCommandVB" _ (ByVal OpCode As Long, _ ByVal PropCode As Long, _ ByVal InputString As String, _ ByRef Output As String) _ As Integer Private Declare Sub XCloseDLL Lib _ "Maser.dll" _ Alias "CloseDLL" () Then to use these functions: ‘ Open the DLL bInstance = XOpenDLL(nModel, nLens, nLensMfr, nGSpeed, nSocketPort, nRS232Port, AddressOf MyCallbackFn) ‘ Send a command nRet = XSendCommand(nOpCode, nPropCode, szInputData, szOutput) ‘ Close the interface Call XCloseDLL お教えください。

  • WinAPIで電卓をクリック

    現在、WinAPIを勉強しており、練習としてVBAを用いて、電卓アプリのボタンをクリックしようとしています。 キーを送るのではなく、クリックで行いたいたいと 考えています。 ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックできず、EditBoxに数字が 入りません。 どのようにすればよいのかご教授ください。 よろしくお願い致します。 環境: WinXP home、 Excel2002、Win付属アプリの電卓v5.1 ---作成したプログラム---- '標準モジュールの中身 Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long 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 Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Sub Main() Dim lngWindWnd As Long 'ウィンドウハンドル Dim ret As Long Dim hCalc As Long 'アプリケーションタイトルより、ウィンドウハンドルを得ます lngWindWnd = FindWindow(vbNullString, "電卓") '８ボタンのハンドル（確実に取れていることを確認 hCalc = FindWindowEx(lngWindWnd, 0, "Button", "8") ret = SetForegroundWindow(lngWindWnd) ret = SendMessage(hCalc, WM_LBUTTONDOWN, 0, 0) End Sub

  • 64ビットエクセルでのAPI宣言/PtrSafe

    エクセルのInputboxで、入力された文字列を自動的にアスタリスクで隠すようにする方法を探し http://okwave.jp/qa/q2371878.html の回答No1のコードがまさに最適なコードで、これまで非常に助かっていました。 ところが、64bitのエクセルでは動かないことがわかりました。 表示されたエラーメッセージの言葉から調べて、PtrSafeという言葉を入れなければならないようなのでAPI宣言を以下のようにしてみました。 #If VBA7 And Win64 Then '64ビット版 Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else '32ビット版 Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long #End If ところが、回答No1のコードで Sub Report_Open()　を実行すると Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String のところがハイライトされてエラーになります。 どう直せば良いのでしょうか？ 全文のコードを乗せると字数制限に引っかかりますので、申し訳ありませんが宣言以外の部分は http://okwave.jp/qa/q2371878.html の回答No1のコードを見てくださいますようお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する