- 日時： 2012/04/04 08:53
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[リッチテキストボックス][][] *
* キーワード：スクロールの同期を取る,表示位置,連動,トップ,揃える, *
***********************************************************************************
元質問：リッチテキストボックス同時スクロールにつ - 大久保 2003/11/04-11:58 No.6510
２つのリッチテキストボックスをマウスのスクロールボタンと連動して表示させたいのですが、
ずれてしまいます。ご教授お願い致します。
http://www.hanatyan.sakura.ne.jp/logbbs/wforum.cgi?mode=allread&no=6510&page=630#6510
------------------------------------------------------------------------------------
※ このサンプルでは行数が多かったりするとうまく動作しませんので改良版を下記の方に
投稿しておきましたのでそちらをご利用下さい。
http://www.hanatyan.sakura.ne.jp/patio/read.cgi?no=317
2012/03/22
------------------------------------------------------------------------------------
※ 下記の元質問者の投稿コードは、元々、某出版社より発行されていたサンプル集のコードが
流出したものと思われます。ネット上で出回っている Tips の殆どが下記方式で同期を取って
います(EM_GETSCROLLPOS を使用した)が、同様に行数が多かった場合は同期しません。
これにより、このサンプル(下記元質問者のコード)は、使用しないようにして下さい。
同様に、EM_SETSCROLLPOS を使って同期を取っているようなコードは使用しないように。
Public Function WindowProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim lngResult As Long
Dim lngwParam As Long
Dim lngNowPos As Long
Dim udtPoint As tagPOINT
Dim lngWin32apiResultCode As Long
Static flg As Boolean
If flg = False Then
flg = True
Select Case uMsg
Case WM_VSCROLL, WM_MOUSEWHEEL
lngWin32apiResultCode = SendMessage(hWnd, EM_GETSCROLLPOS, 0, udtPoint)
With Form1.RichTextBox2
lngWin32apiResultCode = SendMessage(.hWnd, EM_SETSCROLLPOS, 0, udtPoint)
End With
End Select
flg = False
End If
WindowProc = CallWindowProc( _
glngHwnd, hWnd, _
uMsg, wParam, lParam)
End Function
-------------------------------------------------------------------------------
Re^3: リッチテキストボックス同時スクロー.. - 花ちゃん 2003/11/09-08:53 No.6564
-------------------------------------------------------------------------------
どのような場合に、どのようにずれるのでしょうか？
一応試した限りでは問題ないようですが？
一度下記を試して見て下さい。
それとどのようにずれるのでしょうか？
明らかに、RichTextBox1 とRichTextBox2 のトップに表示される行が違うとか
RichTextBox2 の方が遅れて表示されるとか？
スクロールバーをスライドさせた場合とクリックした場合では違うとか、詳しい
症状を教えて頂けませんか。？
念のためOS等の環境(WinXP系だと思うのですが）とRichTextBoxのバージョン(結構違いに
より問題がありますので）
------------------------------------------------------------------------------------
※ このサンプルでは行数が多かったりするとうまく動作しませんので改良版を下記の方に
投稿しておきましたのでそちらをご利用下さい。
http://www.hanatyan.sakura.ne.jp/patio/read.cgi?no=317
2012/03/22
------------------------------------------------------------------------------------
Option Explicit
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_USER = &H400
Private Const EM_SETSCROLLPOS = WM_USER + 222
Private Const EM_GETSCROLLPOS = WM_USER + 221
Private Type tagPOINT
x As Long
y As Long
End Type
Private Sub Command1_Click()
Timer1.Interval = 150
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
Timer1.Interval = 0
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
Dim udtPoint As tagPOINT, Ret As Long
Ret = SendMessage(RichTextBox1.hwnd, EM_GETSCROLLPOS, 0&, udtPoint)
Ret = SendMessage(RichTextBox2.hwnd, EM_SETSCROLLPOS, 0&, udtPoint)
End Sub
|
２つリッチテキストボックスのスクロールの同期を取る(VB6.0)