コード:
Dim hScrollBar As HWND
' スクロールバーのレンジを設定
Function SetScrollRange(ByVal hWnd As HWND,ByVal nBar As Long,ByVal nMinPos As Long,ByVal nMaxPos As Long,ByVal bRedraw As Boolean) As Boolean
Dim si As SCROLLINFO
si.cbSize=SizeOf(SCROLLINFO)
si.fMask=SIF_RANGE
si.nMin=nMinPos
si.nMax=nMaxPos
Return SetScrollInfo(hWnd,nBar,si,bRedraw) As Boolean
End Function
' スクロールバーの位置(つまみの)を設定
Function SetScrollPos(ByVal hWnd As HWND,ByVal nBar As Long,ByVal nPos As Long,ByVal bRedraw As Boolean) As Boolean
Dim si As SCROLLINFO
si.cbSize=SizeOf(SCROLLINFO)
si.fMask=SIF_POS
si.nPos=nPos
Return SetScrollInfo(hWnd,nBar,si,bRedraw) As Boolean
End Function
' スクロールバーの位置(つまみの)を取得
Function GetScrollPos(ByVal hWnd As HWND,ByVal nBar As Long) As Long
Dim si As SCROLLINFO
si.cbSize=SizeOf(SCROLLINFO)
si.fMask=SIF_POS
GetScrollInfo(hWnd,nBar,si)
Return si.nPos
End Function
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
hScrollBar=GetDlgItem(hMainWnd,HScrollBar1)
SetScrollRange(hScrollBar,SB_CTL,0,255,True)
End Sub
Sub MainWnd_HScroll(nScrollCode As Long, nPos As Integer, hwndScrollBar As HWND)
Select Case hwndScrollBar
Case hScrollBar
Dim pos As Long
' 操作する前のつまみの位置
pos = GetScrollPos(hScrollBar,SB_CTL)
Select Case nScrollCode
Case SB_LINELEFT
' つまみの位置を -1
SetScrollPos(hScrollBar,SB_CTL,pos-1,True)
Case SB_LINERIGHT
' つまみの位置を +1
SetScrollPos(hScrollBar,SB_CTL,pos+1,True)
Case SB_PAGELEFT
' つまみの位置を -20
SetScrollPos(hScrollBar,SB_CTL,pos-20,True)
Case SB_PAGERIGHT
' つまみの位置を +20
SetScrollPos(hScrollBar,SB_CTL,pos+20,True)
Case SB_THUMBPOSITION , SB_THUMBTRACK
' つまみの位置をドラッグ位置に設定
SetScrollPos(hScrollBar,SB_CTL,nPos,True)
End Select
' 再描写してやらないといけない
InvalidateRect(hScrollBar,ByVal NULL,True)
UpdateWindow(hScrollBar)
End Select
End Sub