Пробовал через CallBack, но прокручиваются только если двигаешь мышью.
Может где чего пропустил. Гляньте. Есть три текст бокса. Когда кликаешь на вертикальной полосе прокрутки проверяются TopLine всех остальных и прокручиваются до первой. Всё вроде работает, но виснет, пока не начнёшь водить мышью по форме. Остановишь - опять виснет.
- Код: Выделить всё
'Модуль
Private Const EM_SCROLL = &HB5
Private Const WM_VSCROLL = &H115
Public Text1_OldProc As Long, Text3_OldProc As Long, TxtPreCode_OldProc As Long
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = -4
Public Function TextBox_CallBack(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_VSCROLL And wParam < 2 Then
LASMIDE.Text_AlignTopLines hwnd
End If
If hwnd = LASMIDE.Text1.hwnd Then TextBox_CallBack = CallWindowProc(Text1_OldProc, hwnd, uMsg, wParam, lParam)
If hwnd = LASMIDE.Text3.hwnd Then TextBox_CallBack = CallWindowProc(Text3_OldProc, hwnd, uMsg, wParam, lParam)
If hwnd = LASMIDE.TxtPreCode.hwnd Then TextBox_CallBack = CallWindowProc(TxtPreCode_OldProc, hwnd, uMsg, wParam, lParam)
End Function
'Форма
Private Sub Form_Load()
Text1_OldProc = SetWindowLong(Text1.hwnd, GWL_WNDPROC, AddressOf TextBox_CallBack)
Text3_OldProc = SetWindowLong(Text3.hwnd, GWL_WNDPROC, AddressOf TextBox_CallBack)
TxtPreCode_OldProc = SetWindowLong(TxtPreCode.hwnd, GWL_WNDPROC, AddressOf TextBox_CallBack)
End Sub
Function Text_TopLine(ByVal hwnd As Long) As Long
Const EM_GETFIRSTVISIBLELINE = &HCE
Text_TopLine = SendMessage(hwnd, EM_GETFIRSTVISIBLELINE, 0, ByVal 0)
End Function
Sub Text_AlignTopLines(ByVal hWnd_Action As Long)
Dim AlignedTopLine As Long
AlignedTopLine = Text_TopLine(hWnd_Action)
If hWnd_Action <> Text1.hwnd Then Text_Scroll Text1.hwnd, AlignedTopLine
If hWnd_Action <> Text3.hwnd Then Text_Scroll Text3.hwnd, AlignedTopLine
If hWnd_Action <> TxtPreCode.hwnd Then Text_Scroll TxtPreCode.hwnd, AlignedTopLine
End Sub
Sub Text_Scroll(ByVal hwnd As Long, ByVal NewTopLine As Long)
Dim Text_CurrLine As Long
Text_CurrLine = Text_TopLine(hwnd)
If Text_CurrLine = NewTopLine Then Exit Sub
Const EM_SCROLL = &HB5
Const SB_LINEDOWN = 1
Const SB_LINEUP = 0
Dim ScrollMsg As Long, ScrollCount As Long
If Text_CurrLine < NewTopLine Then
ScrollMsg = SB_LINEDOWN
ScrollCount = NewTopLine - Text_CurrLine
ElseIf Text_CurrLine > NewTopLine Then
ScrollMsg = SB_LINEUP
ScrollCount = Text_CurrLine - NewTopLine
End If
Dim Scrolling As Long
For Scrolling = 1 To ScrollCount
SendMessage hwnd, EM_SCROLL, ScrollMsg, 0
Next Scrolling
End Sub