Scroll Client Area of Dialog

Date: 02-16-2022

Return to Index

 
Global hs,vs,Horz,Vert,wMax,hMax As Long
Function PBMain()
End Function
 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "WIN32API.INC"
%IDC_Button = 500 : %IDC_Button2 = 501
Global hDlg As DWord
Global hs,vs,Horz,Vert,wMax, hMax As Long
 
Function PBMain()
   Dialog New Pixels, 0, "Scroll Test", 300,300,200,200, %WS_OverlappedWindow To hDlg
   wMax = 500 : hMax = 500 : hs=5 : vs=5
   Control Add Button, hDlg, %IDC_Button, "Top Left", 0,0,100,20
   Control Add Button, hDlg, %IDC_Button, "Bottom Left", 0,480,100,20
   Control Add Button, hDlg, %IDC_Button, "Top Right", 400,0,100,20
   Control Add Button, hDlg, %IDC_Button, "Bottom Right", 400,480,100,20
   Dialog Show Modal hDlg, Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_InitDialog  : ScrollBarInitialize
      Case %WM_Size        : ScrollBarDisplay
      Case %WM_HScroll     : ScrollBarRespond %SB_Horz, CB.wParam  'respond to horizontal scroll
      Case %WM_VScroll     : ScrollBarRespond %SB_Vert, CB.wParam  'respond to vertical scroll
      Case %WM_MouseWheel
   End Select
End Function
 
Sub ScrollBarInitialize
   Local si As ScrollInfo, wClient,hClient As Long
   Dialog Get Client hDlg TO wClient, hClient                             'w/o scrollbars (called from WM_InitDialog)
   wClient -= GetSystemMetrics(%SM_CXVSCROLL)                             'less vertical scrollbar
   hClient -= GetSystemMetrics(%SM_CXHSCROLL)                             'less horizontal scrollbar
   si.cbSize=Len(si) : si.fMask=%SIF_All                                  'preset values before using SetScrollInfo
   si.nMax=hMax : si.nPage=hClient : SetScrollInfo hDlg, %SB_Vert, si, 1  'set Vert scrollbar properties
   si.nMax=wMax : si.nPage=wClient : SetScrollInfo hDlg, %SB_Horz, si, 1  'set Horz scrollbar properties
End Sub
 
Sub ScrollBarDisplay2
   Local si As ScrollInfo, wClient,hClient As Long
   Dialog Get Client hDlg To wClient, hClient                             'w/o scrollbars (called from WM_InitDialog)
   si.cbSize=Len(si) : si.fMask=%SIF_All                                  'preset values before using SetScrollInfo
   si.nMax=hMax : si.nPage=hClient : SetScrollInfo hDlg, %SB_Vert, si, 1  'set Vert scrollbar properties
   si.nMax=wMax : si.nPage=wClient : SetScrollInfo hDlg, %SB_Horz, si, 1  'set Horz scrollbar properties
End Sub
 
Sub ScrollBarDisplay
   Local wClient,hClient As Long
   Dialog Get Client hDlg TO wClient, hClient
   ShowScrollBar hDlg, %SB_Horz, IsFalse((wClient+GetScrollPos(hDlg,%SB_Horz))>wMax) 'turn off if resize exceeds wMax
   ShowScrollBar hDlg, %SB_Vert, IsFalse((hClient+GetScrollPos(hDlg,%SB_Vert))>hMax) 'turn off if resize exceeps hMax
End Sub
 
Sub ScrollBarRespond(HorzVert As Long, wParam As Long)
   Local si As ScrollInfo, wClient, hClient, oldPos As Long
   si.cbSize=SizeOf(si) : si.fMask=%SIF_All
   GetScrollInfo hDlg, HorzVert, si
   oldPos=si.nPos
   Select Case Lo(Word, wParam)
      Case %SB_LineLeft, %SB_LineUp    :  si.nPos -= IIF(HorzVert,hs,vs)
      Case %SB_PageLeft, %SB_PageUp    :  si.nPos -= si.nPage
      Case %SB_LineRight, %SB_LineDown :  si.nPos += IIF(HorzVert,hs,vs)
      Case %SB_PageRight, %SB_PageDown :  si.nPos += si.nPage
      Case %SB_ThumbTrack              :  si.nPos=Hi(Word, wParam)
      Case Else                        :  Exit Sub
   End Select
   si.nPos=Max&(si.nMin, Min&(si.nPos, si.nMax-si.nPage))
   SetScrollInfo hDlg,HorzVert,si,1
   If HorzVert = %SB_Horz Then ScrollWindow hDlg, oldPos-si.nPos,0 , ByVal %NULL, ByVal %NULL  : Horz = si.nPos
   If HorzVert = %SB_Vert Then ScrollWindow hDlg, 0, oldPos-si.nPos, ByVal %NULL, ByVal %NULL : Vert = si.nPos
   Dialog Set Text hDlg, Using$("#  #", Horz, Vert)
End Sub
 
'gbs_00554
'Date: 03-10-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm