２つのテキストボックスのスクロールの同期を取る改良版(VB6.0)

サンプル投稿用掲示板に投稿している２つリッチテキストボックスのスクロールの同期を取る改良版をテキストボックスで試したものです。

Option Explicit

'指定のウィンドウにメッセージを送る(P750)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
　　ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'トップ位置に表示されている行番号を取得する(797)
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_LINESCROLL = &HB6
Private oldR1Top As Long
Private oldR2Top As Long

Private Sub Timer1_Timer()
'On Error Resume Next
　　Dim R1TopLine As Long, R2TopLine As Long, richthWnd As Long, ScrollLine As Long

　　'表示されている先頭の行を取得
　　R1TopLine = SendMessage(Text1.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
　　R2TopLine = SendMessage(Text2.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)

　　'スクロールバーの位置が同じなら何もしない
　　If R1TopLine = R2TopLine Then
　　　　Exit Sub
　　End If

　　'どちらのスクロールバーが動いたか調査
　　If R1TopLine <> oldR1Top Then
　　　　'Text1 の方がスクロールされた。
　　　　'スクロール行数を計算
　　　　ScrollLine = R1TopLine - R2TopLine
　　　　richthWnd = Text2.hwnd　　'合わせるように移動させる方
　　Else
　　　　'Text2 の方がスクロールされた。
　　　　'スクロール行数を計算
　　　　ScrollLine = R2TopLine - R1TopLine
　　　　'Text2 の方がスクロールされたのでText1 の方をスクロールする
　　　　richthWnd = Text1.hwnd　　'合わせるように移動させる方
　　End If

　　'両方の差分の行をスクロールする
　　SendMessage richthWnd, EM_LINESCROLL, 0&, ScrollLine

　　'現在のトップ行のインデックスを取得
　　R1TopLine = SendMessage(Text1.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
　　oldR1Top = R1TopLine　　'両方同じ位置のはずだから
　　oldR2Top = R1TopLine　　'両方同じ位置のはずだから
End Sub

Private Sub Command1_Click()
'同調をとる
　　Timer1.Interval = 200　 '100 ~ 300 位の範囲で試して下さい
　　Timer1.Enabled = True
　　Command1.Enabled = False
　　Command2.Enabled = True
End Sub

Private Sub Command2_Click()
'同調をとらない
　　Timer1.Interval = 0
　　Timer1.Enabled = False
　　Command2.Enabled = False
　　Command1.Enabled = True
End Sub

'この辺はお好みで
Private Sub Text1_MouseMove(Button As Integer, _
　　　　　　　　　　　　　　　Shift As Integer, x As Single, y As Single)
　　Text1.SetFocus
End Sub

Private Sub Text2_MouseMove(Button As Integer, _
　　　　　　　　　　　　　　　Shift As Integer, x As Single, y As Single)
　　Text2.SetFocus
End Sub

Private Sub Form_Load()
　　Timer1.Enabled = False　　　'プロパティで設定してあれば必要無し
　　Dim i As Long
　　Dim myTxt As String
　　For i = 1 To 1000
　　　　myTxt = myTxt & i & "　あいうえお1234567890かきくけこABCDEFGHIJ" & vbCrLf
　　Next i
　　Text1.Text = myTxt
　　Text2.Text = myTxt
　　Me.Show
End Sub

　　上記実行結果(下記は、Excel ファイルを表示しております。)
　

２．

３．

４．

５．

６．

検索キーワード及びサンプルコードの別名(機能名)

Excel ファイルをTextBox に表示するエクセルファイル　テキストボックス　表示　変数　保存

VBレスキュー(花ちゃん)

Visual Basic 6.0