Question

在VB中,如何让多个textbox用同一个textbox的滚动条？如：text1,text2,text3.......一个滚动全部滚动

互相影响

Answer 1

假设窗体上有控件text1,text2,text3，设置它们的属性为 Multiline=ture,scrollbars=3 ；则可分2步实现text1滚动时，text2,text3也同时滚动功能：
一、新建一个模块，复制下面代码：
Option Explicit
'滚动条信息结构体
Public Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
'显示滚动条与设置滚动条信息函数
Public Declare Function ShowScrollBar Lib "user32" (ByVal hWnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Private Declare Function SetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal n As Long, lpcScrollInfo As Any, ByVal bool As Boolean) As Long
Declare Function GetScrollPos Lib "user32" (ByVal hWnd As Long, ByVal nBar As Long) As Long
'滚动条相应常量与标志
Public Const SIF_RANGE = &H1
Public Const SIF_PAGE = &H2
Public Const SIF_POS = &H4
Public Const SIF_ALL = SIF_RANGE Or SIF_PAGE Or SIF_POS
Public Const SB_HORZ = 0
Public Const SB_VERT = 1
Public Const SB_BOTH = 3
Public Const SB_BOTTOM = 7
Public Const SB_ENDSCROLL = 8
Public Const SB_LINEDOWN = 1
Public Const SB_LINELEFT = 0
Public Const SB_PAGELEFT = 2
Public Const SB_PAGERIGHT = 3
Public Const SB_LINERIGHT = 1
Public Const SB_THUMBTRACK = 5
Public Const SB_THUMBPOSITION = 4
Public Const SB_TOP = 6
'获取窗口过程与设置窗口过程函数及其常量
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" 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 Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
'三个全局变量与常量
Public prevProc As Long
Public a As SCROLLINFO
Public Const hStep = 100
'进程操作
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwsize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwsize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const MAX_LVMSTRING As Long = 255
Public Const MEM_COMMIT = &H1000
Public Const MEM_RELEASE = &H8000
Public Const PAGE_READWRITE = &H4

Public Function SetScrollBarInfo(ByVal hWindow As Long, ScrollBars As Long, Pos As Long) As Boolean '对纵向滚动条的消息进行处理的过程
Dim result As Long
Dim myItem As SCROLLINFO
Dim pHandle As Long
Dim pMyItemMemory As Long
Dim strBuffer() As Byte
Dim Index As Long
Dim tmpString As String
Dim strLength As Long
Dim ProcessID As Long
Dim tmpI As Long

GetWindowThreadProcessId hWindow, ProcessID
If ProcessID = 0 Then Exit Function
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, ProcessID)
pMyItemMemory = VirtualAllocEx(pHandle, 0, Len(myItem), MEM_COMMIT, PAGE_READWRITE)

With myItem
.cbSize = Len(myItem)
.fMask = SIF_POS
.nPos = Pos
End With
result = WriteProcessMemory(pHandle, pMyItemMemory, myItem, Len(myItem), 0)

result = SetScrollInfo(hWindow, ScrollBars, ByVal pMyItemMemory, True)
tmpI = IIf(ScrollBars = SB_HORZ, WM_HSCROLL, WM_VSCROLL)
result = SendMessage(hWindow, tmpI, SB_THUMBPOSITION + &H10000 * Pos, 0)
SetScrollBarInfo = (result = 0)
'释放内存
result = VirtualFreeEx(pHandle, pMyItemMemory, 0, MEM_RELEASE)
result = CloseHandle(pHandle)
End Function

Public Function wndProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
Dim Pos As Long
If wp <> 8 Then
Select Case msg
Case WM_HSCROLL '横向
Pos = wp \ 65536
SetScrollBarInfo Form1.Text2.hWnd, SB_HORZ, Pos '跟随滚动，请根据需要修改hWnd
SetScrollBarInfo Form1.Text3.hWnd, SB_HORZ, Pos
Case WM_VSCROLL '纵向
Pos = wp \ 65536
SetScrollBarInfo Form1.Text2.hWnd, SB_VERT, Pos '跟随滚动，请根据需要修改hWnd
SetScrollBarInfo Form1.Text3.hWnd, SB_VERT, Pos
End Select
End If
wndProc = CallWindowProc(prevProc, hWnd, msg, wp, lp) '将滚动条以外的消息交给原过程处理
End Function
二、在窗体代码区，复制下面代码：
Option Explicit
Private Sub Form_Load()
'SUBCLASS窗口,设定新的窗体过程
prevProc = GetWindowLong(text1.hwnd, GWL_WNDPROC)
SetWindowLong text1.hwnd, GWL_WNDPROC, AddressOf wndProc
End Sub

Private Sub Form_Unload(Cancel As Integer)
'恢复窗口的原过程,避免数据丢失
SetWindowLong text1.hwnd, GWL_WNDPROC, prevProc
End Sub
三、运行程序，复制文本到text1,text2,text3中，使它们出现滚动条为止，然后，拖动Text1滚动条，在即可看到效果。

Answer 2

刚试了一下，不用api也可以实现，关键代码如下：

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyRight Then Text1(1).SelStart = Text1(1).SelStart + 1
End Sub

这个是在窗体上添加两个文本框，输入一样的内容，然后将两个文本框的selstart值都置于开始位置，然后你使第一个文本框获得焦点，按键盘的右方向键，你就会发现当第一个文本框的滚动条滚动时，第二个也跟着滚动。

当然，这个实验太简单了，但这只是给你一个提示，具体的还要添加相关的代码才行

Answer 3

Declare Function GetScrollInfo Lib "user32 " (ByVal hwnd As Long, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long

Declare Function SetScrollPos Lib "user32 " Alias "SetScrollPos " (ByVal hwnd As Long, ByVal nBar As Long, ByVal nPos As Long, ByVal bRedraw As Long) As Long

用这两个

Answer 4

Textbox做成控件数组

Answer 5

你可以用控件数组试试