Declare Sub SetScrollRange Lib "User" (ByVal hWnd As Integer, ByVal nBar As Integer, ByVal nMinPos As Integer, ByVal nMaxPos As Integer, ByVal bRedraw As Integer)
Declare Function SetScrollPos Lib "User" (ByVal hWnd As Integer, ByVal nBar As Integer, ByVal nPos As Integer, ByVal bRedraw As Integer) As Integer
Global Const SB_HORZ = 0
Global Const SB_VERT = 1
Global Const SB_BOTH = 3
Global Const WM_VSCROLL = &H115
Global Const WM_HSCROLL = &H114
Global Const SB_BOTTOM = 7
Global Const SB_ENDSCROLL = 8
Global Const SB_LINEDOWN = 1
Global Const SB_LINEUP = 0
Global Const SB_PAGEDOWN = 3
Global Const SB_PAGEUP = 2
Global Const SB_THUMBPOSITION = 4
Global Const SB_THUMBTRACK = 5
Global Const SB_TOP = 6
Type Rect
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
Declare Sub GetClientRect Lib "User" (ByVal hWnd As Integer, lpRect As Rect)
' Set Pixel for each horizonatal and vertical scrolling
Const ScrollSteps = 12
Dim Shared iThumbTrack As Integer
Sub EnableThumbTrack (iBoolean)
' You can also modify iThumbTrack directly....
If iBoolean Then
iThumbTrack = True
Else
iThumbTrack = False
End If
End Sub
Sub InitScrollPic (PicBox As PictureBox)
PicBox.Top = 0 ' Set Picture to upper left corner
PicBox.Left = 0
End Sub
Sub Scroll (FormHandle As Form, PicHandle As PictureBox, iMsg As Integer, iwParam As Integer, lParam As Long)
If iMsg <> WM_VSCROLL And iMsg <> WM_HSCROLL Then Exit Sub
Dim FormRect As Rect
Dim iPicTop As Long
Dim iPicHeight As Long
Dim iPicLeft As Long
Dim iPicWidth As Long
Dim iPicVPos As Long
Dim iPicHPos As Long
Dim iOldFormMode As Integer
Dim iOldPicMode As Integer
Dim iOldThumbPos As Integer
Dim iFormHeight As Integer
iOldFormMode = FormHandle.ScaleMode
iOldPicMode = PicHandle.ScaleMode
FormHandle.ScaleMode = 3
PicHandle.ScaleMode = 3
GetClientRect FormHandle.hWnd, FormRect
' Test horizontal or vertical scrollbar...
If iMsg = WM_VSCROLL Then
iPicTop = PicHandle.Top
iPicHeight = PicHandle.Height
iFormHeight = FormRect.Bottom
Else
iPicTop = PicHandle.Left
iPicHeight = PicHandle.Width
iFormHeight = FormRect.Right
End If
' Only one algorithm is needed for both scrollbars
iPicVPos = iPicTop + iPicHeight
Select Case iwParam
Case SB_LINEUP
iPicTop = iPicTop + ScrollSteps
Case SB_LINEDOWN
iPicTop = iPicTop - ScrollSteps
Case SB_PAGEDOWN
iPicTop = iPicTop - iFormHeight
Case SB_PAGEUP
iPicTop = iPicTop + iFormHeight
Case SB_THUMBPOSITION
If Not iThumbTrack Then iPicTop = -lParam
Case SB_THUMBTRACK
If iThumbTrack Then iPicTop = -lParam
End Select
' Are we still inside the picture range ?
' If not, correct position
If iPicTop + iPicHeight < iFormHeight Then iPicTop = iFormHeight - iPicHeight
If iPicTop + iPicHeight > iPicHeight Then iPicTop = 0
' Now decide again, which scrollbar to handle (sorry for bad english...)
If iMsg = WM_VSCROLL Then
PicHandle.Top = iPicTop ' Set new picture position