VB设置窗口滚动条
出处：网络

'此代码允许横向和纵向滚动
'1000vb.net all rights reserved
'使用方法：
'建立一个Form,做2个Public 方法(VChange和HChange)
'form_load的时候hook
'form_unload的时候unhook
'在vchange和hchange方法中对窗体布局调整
'例如
Public Sub VChange(ByVal nScrollCode As Long)
Dim nPos As Long
Dim nDltPos As Long

nPos = GetScrollPos(Me.hwnd, SB_VERT)
Select Case nScrollCode
Case SB_LINELEFT
nDltPos = -5
Case SB_LINERIGHT
nDltPos = 5
Case SB_PAGELEFT
nDltPos = -50
Case SB_PAGERIGHT
nDltPos = 50
End Select
If nPos + nDltPos < 0 Then
nDltPos = -nPos
End If
If nPos + nDltPos > Ml_WINDOW_HEIGHT + 50 Then
nDltPos = Me.ScaleWidth - nPos
End If

SetScrollPos Me.hwnd, SB_VERT, nPos + nDltPos, True
Picture1.Top = 30 - (nPos + nDltPos) * Screen.TwipsPerPixelY
End Sub

Option Explicit
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115

Public Const SB_BOTH = 3
Public Const SB_HORZ = 0
Public Const SB_VERT = 1

Public Const ESB_ENABLE_BOTH = &H0

Public Declare Function ScrollWindow Lib "user32" (ByVal hwnd As Long, ByVal XAmount As Long, ByVal YAmount As Long, ByVal lpRect As Long, ByVal lpClipRect As Long) As Long
Public Declare Function SetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, ByVal nPos As Long, ByVal bRedraw As Long) As Long

Public Declare Function SetScrollRange Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, ByVal nMinPos As Long, ByVal nMaxPos As Long, ByVal bRedraw As Long) As Long

Public Declare Function EnableScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wSBflags As Long, ByVal wArrows 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function GetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long) As Long

Public Const SB_LINELEFT = 0

Public Const SB_LINERIGHT = 1

Public Const SB_PAGELEFT = 2
Public Const SB_PAGERIGHT = 3

Public Const GWL_WNDPROC = -4

Global gnlpPrevWndProc As Long
Global goHookForm As Form

Public Sub Hook(frm As Form)
Set goHookForm = frm
gnlpPrevWndProc = SetWindowLong(goHookForm.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub Unhook()
SetWindowLong goHookForm.hwnd, GWL_WNDPROC, gnlpPrevWndProc
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_HSCROLL Then
Call goHookForm.HChange(wParam And &HFFFF)
End If
If uMsg = WM_VSCROLL Then
Call goHookForm.VChange(wParam And &HFFFF)
End If
WindowProc = CallWindowProc(gnlpPrevWndProc, hwnd, uMsg, wParam, lParam)
End Function

[返回]

首页 | 设为首页 | 加入收藏 | 关于本站 | 友情链接 | 版权声明