テキストボックスのスクロール制御方法は？ (ID:116854)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 暇だったのでサンプルを作ってみました。 以下にサンプルを書いておきます。 適当に改造して使用してください。 １）フォームに２つのテキストボックス（Text1及びText2）を貼り付けます。 ２）フォームのロード及びアンロードイベントプロシージャに下記コード（フォーム（Form1.frm）のコード）を書き込みます。 ３）標準モジュールを追加し下記コード（標準モジュール（Module1.bas）のコード）を書き込みます。 ４）実行してText1をスクロールするとText2も連動してスクロールします。 '------------------------------------------------------------------------------- ' ' フォーム（Form1.frm）のコード ' '------------------------------------------------------------------------------- Option Explicit Private Sub Form_Load() Dim i As Long Text1.Text = "" For i = 1 To 100 Text1.Text = Text1.Text & "Line=" & Format(i) & vbCrLf Next Text2.Text = Text1.Text lngOldWnd = SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf WindowProc) End Sub Private Sub Form_Unload(Cancel As Integer) Dim lngWnd As Long If lngOldWnd Then lngWnd = SetWindowLong(Text1.hWnd, GWL_WNDPROC, lngOldWnd) End If End Sub '------------------------------------------------------------------------------- ' ' 標準モジュール（Module1.bas）のコード ' '------------------------------------------------------------------------------- Option Explicit Public Const GWL_WNDPROC = -4 Public Const GCL_WNDPROC = -24 Public Const EM_GETFIRSTVISIBLELINE = &HCE Public Const WM_PAINT = &HF Public Const EM_LINESCROLL = &HB6 Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public lngOldWnd As Long Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim lngSrcIdx As Long Dim lngDstIdx As Long Dim lngCnt As Long Select Case uMsg Case WM_PAINT lngSrcIdx = SendMessage(Form1.Text1.hWnd, EM_GETFIRSTVISIBLELINE, 0&, 0&) lngDstIdx = SendMessage(Form1.Text2.hWnd, EM_GETFIRSTVISIBLELINE, 0&, 0&) lngCnt = lngSrcIdx - lngDstIdx If lngCnt Then PostMessage Form1.Text2.hWnd, EM_LINESCROLL, 0&, lngCnt End If End Select WindowProc = CallWindowProc(lngOldWnd, hWnd, uMsg, wParam, lParam) End Function