ab.com コミュニティ

コード: 全て選択

Dim hScrollBar As HWND
Dim si As SCROLLINFO

	si.cbSize=SizeOf(SCROLLINFO)
	si.fMask=SIF_RANGE Or SIF_POS Or SIF_PAGE
	si.nPos=0
	si.nMin=0
	si.nMax=255
	si.nPage=1

	hScrollBar=GetDlgItem(hMainWnd,HScrollBar1)
	SetScrollInfo(hScrollBar,SB_CTL,si,TRUE)

コード: 全て選択

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