tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
2つリッチテキストボックスのスクロールの同期を取る改良版(VB6.0) ( No.0 )  [親スレッドへ]
日時: 2012/03/23 11:18
名前: VBレスキュー(花ちゃん)

***********************************************************************************
* カテゴリー:[リッチテキストボックス][テキストボックス][]                        *
* キーワード:スクロールバーの同期を取る,表示位置,連動,トップ,揃える,同調         *
***********************************************************************************

'==================================================================================
'投 稿 者:VBレスキュー(花ちゃん)
'SampleNo:590    2012.03.22     @ 2012.03.22
'タイトル:2つのRichTextBoxのスクロールバーの同期をとるパートU(590) - VB6.0
'動作確認:Windows XP / Windows Vista / Windows 7 / 60,000行の 約 9 MB で確認
'下記の掲示板の質問で作り直した分です。
' http://hanatyan.sakura.ne.jp/vb60bbs/wforum.cgi?mode=allread&no=15440&page=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 ("test3.txt")    'ファイルの読み込み
   RichTextBox2.LoadFile ("test4.txt")    'ファイルの読み込み
   Me.Show
End Sub


  実行結果図(画像をクリックすると元のサイズで見る事ができます。)



 [スレッド一覧へ] [親スレッドへ]