サンプル投稿用掲示板 VB2005 ～ 用トップページ VB6.0 用 トップページ
- 日時： 2012/03/23 11:18
- 名前： VBレスキュー(花ちゃん)
- ***********************************************************************************
* カテゴリー：[リッチテキストボックス][テキストボックス][] *
* キーワード：スクロールバーの同期を取る,表示位置,連動,トップ,揃える,同調 *
***********************************************************************************
'==================================================================================
'投 稿 者：VBレスキュー(花ちゃん)
'SampleNo：590 2012.03.22 ① 2012.03.22
'タイトル：２つのRichTextBoxのスクロールバーの同期をとるパートⅡ(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
実行結果図(画像をクリックすると元のサイズで見る事ができます。)
 |
