Как связать вертикальную прокрутку двух идентичных TextBox

morgann55 · Регистрация: 09.02.2012

Студворк — интернет-сервис помощи студентам

В двух идентичных TextBox одинаковое кол-во строк (линий) - разные данные по определённым позициям.
Надо: прокручиваю 1-й - синхронно прокручивается 2-й (?????)
Попробовал так:

Visual Basic
1
2
3
Private Sub Timer1_Timer()
Text2.SelStart = Text1.SelStart
End Sub

Никакой реакции

Подскажите, ПЛЗ !!

@antonboom · 08.04.2013, 22:12

может поможет..

@The trick · 08.04.2013, 23:44

Ответ - сабклассинг:
Форма:

Visual Basic
1
2
3
4
5
6
7
Private Sub Form_Load()
    txtEdit(0).Text = txtEdit(1).Text
    Hook txtEdit(1).hwnd
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    UnHook txtEdit(1).hwnd
End Sub

Модуль:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long) As Long
Private Declare Function GetMem2 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
 
Dim lpPrevWndProc As Long
Private Const SB_VERT = 1
Private Const SB_TOP = 6
Private Const EM_SCROLL = &HB5
Private Const EM_LINESCROLL = &HB6
Private Const GWL_WNDPROC& = (-4&)
Private Const WM_VSCROLL = &H115
Private Const SB_THUMBTRACK = 5
Private Const SB_THUMBPOSITION = 4
Private Const SB_LINEDOWN = 1
Private Const SB_PAGEDOWN = 3
Private Const SB_PAGEUP = 2
 
Public Sub Hook(hwnd As Long)
    lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHook(hwnd As Long)
    Call SetWindowLong(hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Pos As Long
    Select Case uMsg
    Case WM_VSCROLL
        If ((wParam And &HFFFF&) = SB_THUMBTRACK) Or ((wParam And SB_THUMBPOSITION) = SB_THUMBPOSITION) Then
            GetMem2 VarPtr(wParam) + 2, VarPtr(Pos)
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_SCROLL, SB_TOP, ByVal 0&
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_LINESCROLL, 0&, ByVal Pos
        ElseIf (wParam And &HFFFF&) = SB_LINEDOWN Then
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_LINESCROLL, 0&, ByVal 1&
        ElseIf (wParam And &HFFFF&) = SB_PAGEDOWN Then
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_SCROLL, SB_PAGEDOWN, ByVal 0&
        ElseIf (wParam And &HFFFF&) = SB_PAGEUP Then
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_SCROLL, SB_PAGEUP, ByVal 0&
        ElseIf (wParam And &HFFFF&) = 0 Then
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_LINESCROLL, 0&, ByVal -1&
        End If
    End Select
    WindowProc = CallWindowProcA(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End Function

Можно и по таймеру сделать, но это очень не красиво.

morgann55 · 09.04.2013, 02:24 **[ТС]**

The trick, Спасибо !! С двумя Боксами очень хорошо

Но у меня 4 Бокса (думал остальные сам подключу)... Добавил в твой проект ещё один бокс (txtEdit(2)) и просто переписал:

Visual Basic
1
2
3
4
5
6
7
Private Sub Form_Load()
    'txtEdit(0).Text = txtEdit(1).Text
For i = 1 To 20:
txtEdit(0) = txtEdit(0) + Str(i) + vbNewLine
Next i:
    Hook txtEdit(2).hwnd
End Sub

Но теперь txtEdit(2) двигает ТОЛЬКО txtEdit(0), а txtEdit(1) выпал

Где чего прописать чтоб двигались все ??

Добавлено через 23 минуты
Нашёл - в модуле добавил txtEdit(1):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Pos As Long
    Select Case uMsg
    Case WM_VSCROLL
        If ((wParam And &HFFFF&) = SB_THUMBTRACK) Or ((wParam And SB_THUMBPOSITION) = SB_THUMBPOSITION) Then
            GetMem2 VarPtr(wParam) + 2, VarPtr(Pos)
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_SCROLL, SB_TOP, ByVal 0&
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_LINESCROLL, 0&, ByVal Pos
            '------------------
SendMessageA frmSynchTextBox.txtEdit(1).hwnd, EM_SCROLL, SB_TOP, ByVal 0&
SendMessageA frmSynchTextBox.txtEdit(1).hwnd, EM_LINESCROLL, 0&, ByVal Pos
 
        ElseIf (wParam And &HFFFF&) = SB_LINEDOWN Then
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_LINESCROLL, 0&, ByVal 1&
SendMessageA frmSynchTextBox.txtEdit(1).hwnd, EM_LINESCROLL, 0&, ByVal 1&
        ElseIf (wParam And &HFFFF&) = SB_PAGEDOWN Then
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_SCROLL, SB_PAGEDOWN, ByVal 0&
SendMessageA frmSynchTextBox.txtEdit(1).hwnd, EM_SCROLL, SB_PAGEDOWN, ByVal 0&
        ElseIf (wParam And &HFFFF&) = SB_PAGEUP Then
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_SCROLL, SB_PAGEUP, ByVal 0&
SendMessageA frmSynchTextBox.txtEdit(1).hwnd, EM_SCROLL, SB_PAGEUP, ByVal 0&
        ElseIf (wParam And &HFFFF&) = 0 Then
            SendMessageA frmSynchTextBox.txtEdit(0).hwnd, EM_LINESCROLL, 0&, ByVal -1&
SendMessageA frmSynchTextBox.txtEdit(1).hwnd, EM_LINESCROLL, 0&, ByVal -1&
        End If
    End Select
    WindowProc = CallWindowProcA(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End Function

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .	SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .
Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .	SDL3 для Android: Загрузка PNG с альфа-каналом с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 28.01.2026 Содержание блога SDL3 имеет собственные средства для загрузки и отображения PNG-файлов с альфа-каналом и базовой работы с ними. В этой инструкции используется функция SDL_LoadPNG(), которая. . .	SDL3 для Android: Загрузка PNG с альфа-каналом с помощью SDL3_image 8Observer8 27.01.2026 Содержание блога SDL3_image - это библиотека для загрузки и работы с изображениями. Эта пошаговая инструкция покажет, как загрузить и вывести на экран смартфона картинку с альфа-каналом, то есть с. . .	Влияние грибов на сукцессию anaschu 26.01.2026 Бифуркационные изменения массы гриба происходят тогда, когда мы уменьшаем массу компоста в 10 раз, а скорость прироста биомассы уменьшаем в три раза. Скорость прироста биомассы может уменьшаться за. . .

@antonboom bmstu-team 301 / 136 / 91 Регистрация: 10.01.2012 Сообщений: 420 Записей в блоге: 10
	08.04.2013, 22:12
	может поможет.. 1

Как связать вертикальную прокрутку двух идентичных TextBox

Решение