４．２つのリッチテキストボックスのスクロールの同期を取る

１．２つのリッチテキストボックスのスクロールの同期を取る改良版 ２． ３． ４． ５． ６．

下記プログラムコードに関する補足・注意事項　 動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6) Excel 2010 Option　：[Option Explicit] 参照設定： 使用 API：SendMessage その他　：プロジェクト→コンポーネント→コントロールで Microsoft Rich Textbox Control 6.0 にチェックを入れ、 　　　　：表示されたコントロールをフォームに貼り付けて下さい。

１．２つのリッチテキストボックスのスクロールの同期を取る改良版

1行当たり100文字程度の60,000行のテキストファイル(約9MB)を使って、Windows XP / Windows Vista / Windows 7 で動作を確認しております。 又、左右どちらのRichTextBoxをスクロールしても同調するようにもしておりますので、旧のサンプルは使用しないようにしてこれを使って下さい。(サンプル投稿用掲示板に投稿分と同じです。) 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(RichTextBox1.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&) 　 R2TopLine = SendMessage(RichTextBox2.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&) 　 'スクロールバーの位置が同じなら何もしない 　 If R1TopLine = R2TopLine Then 　　　Exit Sub 　 End If 　 'どちらのスクロールバーが動いたか調査 　 If R1TopLine <> oldR1Top Then 　　　'RichTextBox1 の方がスクロールされた。 　　　'スクロール行数を計算 　　　ScrollLine = R1TopLine - R2TopLine 　　　richthWnd = RichTextBox2.hwnd　　'合わせるように移動させる方 　 Else 　　　'RichTextBox2 の方がスクロールされた。 　　　'スクロール行数を計算 　　　ScrollLine = R2TopLine - R1TopLine 　　　'RichTextBox2 の方がスクロールされたのでRichTextBox1 の方をスクロールする 　　　richthWnd = RichTextBox1.hwnd　　'合わせるように移動させる方 　 End If 　 '両方の差分の行をスクロールする 　 SendMessage richthWnd, EM_LINESCROLL, 0&, ScrollLine 　 '現在のトップ行のインデックスを取得 　 R1TopLine = SendMessage(RichTextBox1.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 RichTextBox1_MouseMove(Button As Integer, _ 　　　　　　　　　　　　　　　Shift As Integer, x As Single, y As Single) 　 RichTextBox1.SetFocus End Sub Private Sub RichTextBox2_MouseMove(Button As Integer, _ 　　　　　　　　　　　　　　　Shift As Integer, x As Single, y As Single) 　 RichTextBox2.SetFocus End Sub Private Sub Form_Load() 　 Timer1.Enabled = False　　　　　　　　 'プロパティで設定してあれば必要無し 　 '各自ご用意下さい。 　 RichTextBox1.LoadFile ("..\test.txt")　　'ファイルの読み込み 　 RichTextBox2.LoadFile ("..\test.txt")　　'ファイルの読み込み 　 Me.Show End Sub 　　図１．上記実行結果及びコントロール類の配置図

２．

３．

４．

５．

６．

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