|
|
|||||||
| Source Code PowerBASIC and related source code. Please do not post questions or discussions, just source code. |
 |
|
|
Thread Tools | Display Modes |
|
#1
Jan 8th, 2005, 01:33 PM
|
|||
|
|||
|
Scroll Bars for the Dialog
Hi All,
Here is the skeleton code for the Dialog's Scroll Bars which actualy does scroll the Dialog. Code has been made as simple as possible and is generously commented. Enjoy MN Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' WORKING Dialog's own Scroll Bars ' Based on code provided by Borje Hagsten, ' simplified and "beautyfied" by Maciej Neyman. ' Free to use by all PB programers. '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ '-------------------------------------------------------------------- #COMPILE EXE #INCLUDE "WIN32API.INC" '-------------------------------------------------------------------- %IDC_LABEL1 = 200 '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Dialog and Controls setup '-------------------------------------------------------------------- FUNCTION PBMAIN () AS LONG LOCAL hDlg AS DWORD DIALOG NEW 0, "Dialog's Scroll Bars ",,, 450, 250, _ %WS_CAPTION OR %WS_SYSMENU OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX, TO hDlg DIALOG SET COLOR hDlg, -1, RGB(74, 164, 74) '------------------------------------------------------------------ CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !", 100, 100, 300, 200 CONTROL SET COLOR hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74) '------------------------------------------------------------------ DIALOG SHOW MODAL hDlg CALL DlgProc END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Main callback '-------------------------------------------------------------------- CALLBACK FUNCTION DlgProc() AS LONG ' initialize scrollbar constants here LOCAL w AS LONG, h AS LONG, oldPos AS LONG, si AS SCROLLINFO LOCAL vt AS LONG, ht AS LONG, hs AS LONG, vs AS LONG '========================================================================== 'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE 'SCROLL BARS: (try to experiment with these values) '========================================================================== w = 600 'This is the number of dialog units by which the Dialog's Window 'will scroll horizontaly if the thumb of the Scrolling Bar 'travels between its extreme positions left and right 'Reasonable (but not compulsory) value for it is between 200 to 2000 h = 400 'This is the number of dialog units by which the Dialog's Window 'will scroll verticaly if the thumb of the Scrolling Bar 'travels between its extreme positions top and bottom 'Reasonable (but not compulsory) value for it is between 200 to 1600 vt = 50 'lenght of the vertical scroll bar's thumb, this is also the amount 'of dialog units by which the dialog will scroll verticaly if mouse is 'clicked between the ends of the scroll bar and the thumb itself 'reasonable value for it is between 10 and h/2 ht = 50 'lenght of the horizontal scroling bar's thumb, this is also the amount 'of dialog units by which the dialog will scroll horizontaly if mouse is 'clicked between the ends of the scroll bar and the thumb itself 'reasonable value for it is between 10 and w/2 hs = 5 'number of dialog units by which the Dialog scrolls horizontaly when the 'small arrow on either end of scroling bar is activated by mouse 'reasonable values for it is between 1 and 30. Small value produces 'smother but slower scrolling, the higher value is faster but more 'jerki - the Dialog scrolls by steps determined by this value. vs = 5 'number of dialog units by which the Dialog scrolls verticaly when the 'small arrow on either end of scroling bar is activated by mouse 'reasonable values for it is between 1 and 30. Small value produces 'smother but slower scrolling, the higher value is faster but more 'jerki - the Dialog scrolls by steps determined by this value. '---------------- 'If scroling by dialog units and not by pixels is giving you stomachache 'remove REM from the next line. REM DIALOG UNITS CBHNDL, w, h TO PIXELS w, h '========================================================================== ' This is all you have to decide upon, the rest just copy. ' If you remove all comments, the code become quite lean! '========================================================================== SELECT CASE CBMSG CASE %WM_INITDIALOG ' initialize scrollbars here '--------------------------------------------------------------------------------- si.cbSize = LEN(si) ' get place holders for the si parameters si.fMask = %SIF_ALL ' setting the topological space for the scroll bars si.nMin = 0 ' min scroll pos si.nMax = h ' max scroll pos si.nPage = vt ' lenght of the vertical scroll bar's thumb SetScrollInfo CBHNDL, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents ' "TRUE" and causes redraw of the scroll bar '-------------------------------------------------------------------------------- si.nMin = 0 ' min scroll pos si.nMax = w ' max scroll pos si.nPage = ht ' width of the horizontal scroll bar thumb si.nPos = 0 ' initial position of the thumbs SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents ' "TRUE" and causes redraw of the scroll bar '-------------------------------------------------------------------------------- CASE %WM_COMMAND ' <- a control is calling SELECT CASE CBCTL ' <- look at control's id CASE %IDCANCEL IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog DIALOG END CBHNDL END IF END SELECT CASE %WM_HSCROLL ' call from the horizontal scroll bar si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_HORZ, si oldPos = si.nPos SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINELEFT : si.nPos = si.nPos - hs CASE %SB_PAGELEFT : si.nPos = si.nPos - si.nPage CASE %SB_LINERIGHT : si.nPos = si.nPos + hs CASE %SB_PAGERIGHT : si.nPos = si.nPos + si.nPage CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT 'To limit scroling range remove REM from the next line. 'If you don't then you can keep scrolling indefinitelly (well, almost) 'by using small arrrows on the end of the scroll bar. REM si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage)) ' Update the scroll bar and scroll the client area si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_HORZ, si, 1 'remember new geometry of the horizontal scroll bar ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL 'actual scroling action FUNCTION = 1 CASE %WM_VSCROLL 'call from the vertical scroll bar si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINEUP : si.nPos = si.nPos - vs CASE %SB_PAGEUP : si.nPos = si.nPos - si.nPage CASE %SB_LINEDOWN : si.nPos = si.nPos + vs CASE %SB_PAGEDOWN : si.nPos = si.nPos + si.nPage CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT 'To limit scroling range remove REM from the next line 'If you don't then you can keep scrolling indefinitelly (well, almost) 'by using small arrrows on the end of the scroll bar. REM si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage + 1)) ' Update the scroll bar and scroll the client area si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_VERT, si, 1 'remember new geometry of the vertical scroll bar ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL 'actual scroling action FUNCTION = 1 END SELECT END FUNCTION [This message has been edited (some spelling) by Maciej NEYMAN (edited January 08, 2005).] [This message has been edited by Maciej NEYMAN (edited January 17, 2005).] 
|
|
#2
Mar 19th, 2006, 07:19 PM
|
|||
|
|||
|
This is new code which also provides scrolling with the Mouse Wheel
and the keyboard. Enjoy, Maciej Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' WORKING Dialog's own Scroll Bars ' Based on code provided by Borje Hagsten, ' simplified and "beautyfied" by Maciej Neyman. ' Free to use by all PB programers. '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Additional scroling using Mouse Wheel and keyboard based on code ' posted by Semen Matusowsky and others. ' Tested on WinME and XP (Home edition) ' Compiled with PBWin8 '-------------------------------------------------------------------- '-------------------------------------------------------------------- #COMPILE EXE #INCLUDE "WIN32API.INC" '-------------------------------------------------------------------- %IDC_LABEL1 = 200 GLOBAL Finito AS LONG GLOBAL hDlg AS LONG '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Dialog and Controls setup '-------------------------------------------------------------------- FUNCTION PBMAIN () AS LONG ' LOCAL hDlg AS DWORD DIALOG NEW 0, "Dialog's Scrolling System ",,, 450, 250, _ %WS_CAPTION OR %WS_SYSMENU OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX, TO hDlg DIALOG SET COLOR hDlg, -1, RGB(74, 164, 74) '------------------------------------------------------------------ 'CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !", 100, 100, 300, 200 CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !" + $CRLF + _ "Try also PgUp, PgDn keys and the Mouse wheel if you have Mouse with the wheel."+ $CRLF + _ "Please note, there is additional switch (button) under the Wheel." + $CRLF +_ "If you press hard the Wheel, the switch is activated and the"+ $CRLF +_ "scrolling changes direction.", 100, 100, 300, 200 CONTROL SET COLOR hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74) '------------------------------------------------------------------ DIALOG SHOW MODAL hDlg CALL DlgProc END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Main callback '-------------------------------------------------------------------- CALLBACK FUNCTION DlgProc() AS LONG REM SetFocus hDlg ' To prevent crashing the XP un-REM this statement ' but keep it REM-ed in 9x varieties as it will ' crash them stright away. Do not ask me why. ' Ask Billy. ' initialize scrollbar constants here LOCAL w AS LONG, h AS LONG, oldPos AS LONG, si AS SCROLLINFO LOCAL vt AS LONG, ht AS LONG, hs AS LONG, vs AS LONG '========================================================================== 'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE 'SCROLL BARS: (try to experiment with these values) '========================================================================== w = 600 'This is the number of dialog units by which the Dialog's Window 'will scroll horizontaly if the thumb of the Scrolling Bar 'travels between its extreme positions left and right 'Reasonable (but not compulsory) value for it is between 200 to 2000 h = 400 'This is the number of dialog units by which the Dialog's Window 'will scroll verticaly if the thumb of the Scrolling Bar 'travels between its extreme positions top and bottom 'Reasonable (but not compulsory) value for it is between 200 to 1600 vt = 50 'lenght of the vertical scroll bar's thumb, this is also the amount 'of dialog units by which the dialog will scroll verticaly if mouse is 'clicked between the ends of the scroll bar and the thumb itself 'reasonable value for it is between 10 and h/2 ht = 50 'lenght of the horizontal scroling bar's thumb, this is also the amount 'of dialog units by which the dialog will scroll horizontaly if mouse is 'clicked between the ends of the scroll bar and the thumb itself 'reasonable value for it is between 10 and w/2 hs = 5 'number of dialog units by which the Dialog scrolls horizontaly when the 'small arrow on either end of scroling bar is activated by mouse 'reasonable values for it is between 1 and 30. Small value produces 'smother but slower scrolling, the higher value is faster but more 'jerki - the Dialog scrolls by steps determined by this value. vs = 5 'number of dialog units by which the Dialog scrolls verticaly when the 'small arrow on either end of scroling bar is activated by mouse 'reasonable values for it is between 1 and 30. Small value produces 'smother but slower scrolling, the higher value is faster but more 'jerki - the Dialog scrolls by steps determined by this value. '---------------- 'If scroling by dialog units and not by pixels is giving you stomachache 'remove REM from the next line. REM DIALOG UNITS CBHNDL, w, h TO PIXELS w, h '========================================================================== ' This is all you have to decide upon, the rest just copy. ' If you remove all comments, the code become quite lean! '========================================================================== SELECT CASE CBMSG CASE %WM_DESTROY : Finito = 1 CASE %WM_INITDIALOG DIALOG POST hDlg, %WM_MOUSEWHEEL, 0, 0 'For some, unknown to me reasons, without this statement 'Windows does not process keyboard PgUp, PgDn input 'necessary for scroling using the Keyboard ' initialize scrollbars here '--------------------------------------------------------------------------------- si.cbSize = LEN(si) ' get place holders for the si parameters si.fMask = %SIF_ALL ' setting the topological space for the scroll bars si.nMin = 0 ' min scroll pos for thumb si.nMax = h ' max scroll pos for thumb si.nPage = vt ' lenght of the vertical scroll bar's thumb SetScrollInfo CBHNDL, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents ' "TRUE" and causes redraw of the scroll bar '-------------------------------------------------------------------------------- si.nMin = 0 ' min scroll pos for thumb si.nMax = w ' max scroll pos for thumb si.nPage = ht ' width of the horizontal scroll bar thumb si.nPos = 0 ' initial position of the thumbs SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents ' "TRUE" and causes redraw of the scroll bar '-------------------------------------------------------------------------------- CASE %WM_COMMAND ' <- a control is calling SELECT CASE CBCTL ' <- look at control's id CASE %IDCANCEL IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog DIALOG END CBHNDL END IF END SELECT CASE %WM_HSCROLL ' call from the horizontal scroll bar si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_HORZ, si oldPos = si.nPos SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINELEFT : si.nPos = si.nPos - hs CASE %SB_PAGELEFT : si.nPos = si.nPos - si.nPage CASE %SB_LINERIGHT : si.nPos = si.nPos + hs CASE %SB_PAGERIGHT : si.nPos = si.nPos + si.nPage CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT 'To limit scroling range remove REM from the next line. 'If you don't then you can keep scrolling indefinitelly (well, almost) 'by using small arrrows on the end of the scroll bar. REM si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage)) ' Update the scroll bar and scroll the client area si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_HORZ, si, 1 'remember new geometry of the horizontal scroll bar ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL 'actual scroling action FUNCTION = 1 CASE %WM_VSCROLL 'call from the vertical scroll bar si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINEUP : si.nPos = si.nPos - vs CASE %SB_PAGEUP : si.nPos = si.nPos - si.nPage CASE %SB_LINEDOWN : si.nPos = si.nPos + vs CASE %SB_PAGEDOWN : si.nPos = si.nPos + si.nPage CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT 'To limit scroling range remove REM from the next line 'If you don't then you can keep scrolling indefinitelly (well, almost) 'by using small arrrows on the end of the scroll bar. REM si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage + 1)) ' Update the scroll bar and scroll the client area si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_VERT, si, 1 'remember new geometry of the vertical scroll bar ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL 'actual scroling action FUNCTION = 1 '=============================================================================================== ' Scrolling by Mouse wheel '=============================================================================================== CASE %WM_MBUTTONDOWN 'Use of the Middle Mouse Button (under the wheel) click as the toggle GLOBAL D AS LONG 'for the V/H scroling change IF D = 0 THEN D = 1 D= D*(-1) CASE %WM_MOUSEWHEEL LOCAL M AS LONG LOCAL K AS LONG ' If D = -1 THEN M = %SB_VERT Else M = %SB_HORZ ' Changing scrolling direction V/H IF HIWRD(CBWPARAM)> 50000 THEN K = 1 ELSE K = -1 'setting scrolling movement Up/Down, Left/Right IF D = -1 THEN si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos si.nPos = si.nPos +vs*3*K 'multiplied by 3 here to increase speed of scrolling - could be changed si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_VERT, si, 1 ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL FUNCTION = 1 ELSE si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_HORZ, si oldPos = si.nPos si.nPos = si.nPos +hs*3*K 'multiplied by 3 here to increase speed of scrolling - could be changed si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL FUNCTION = 1 END IF '=============================================================================================== ' Scrolling by Keyboard ( PgUp, PgDn) ' I have decided to use the Arrow's Keys to jump between controls or cells ' You can use them for scroling if you wish, just replace %VK_PGUP/PGDN with ' the relevant arrow's equates. Also you can change "h" parameter to your heart content. '=============================================================================================== ' Keyboard interception '----------------------- LOCAL Mes AS tagMsg ' Windows inherent sub classing (Win32API)! Look under MSG DO WHILE GetMessage(Mes, %NULL, 0, 0) 'Keyboard interception SELECT CASE Mes.message CASE %WM_KEYDOWN SELECT CASE Mes.wParam CASE %WM_DESTROY Finito = 1 CASE 27 Finito = 1 CASE %VK_PGDN '-------------------------------------- si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos si.nPos = si.nPos + h/2 ' h = number of units to scroll verticaly si.fMask = %SIF_POS SetScrollInfo hDlg, %SB_VERT, si, 1 ScrollWindow hDlg, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL CASE %VK_PGUP si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos si.nPos = si.nPos - h/2 ' h/2 = number of units to scroll verticaly si.fMask = %SIF_POS SetScrollInfo hDlg, %SB_VERT, si, 1 ScrollWindow hDlg, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL END SELECT END SELECT IF IsDialogMessage(hDlg, Mes) = %FALSE THEN TranslateMessage Mes DispatchMessage Mes END IF IF Finito <> 0 THEN EXIT DO LOOP FUNCTION = 1 '============================================================================================================ END SELECT END FUNCTION [This message has been edited by Maciej NEYMAN (edited March 21, 2006).]
|
|
#3
Apr 25th, 2006, 07:48 AM
|
|||
|
|||
|
Hi All,
I just have no more time to play with this silly scroll bars, so this is my final code. I have rearranged the code so keyboard interception is done in the modeless dialog and the scrolling is done in the call-back function. It seems to work now in the x98 and XP without crashes and without need to change the coding for different versions of the OS we all know and love: Code:
'======================================================================= ' Working Dialog's Scroll Bars and simple keyboard interception sample ' (necessary for the scroling by PgUp & PgDown keys on the keyboard) ' by Maciej Neyman. ' 'Disclaimer: 'This code is provided as-is and it does not have any warranty of any kind. 'If it causes collapse of the Universe, the Author does not want to know it. 'Refer that case to Inteligent Designer and blame Billy G. for it. ' 'User is responsible for any use and/or misuse of the code. 'If you don't agree please don't use this code. '===================================================================== #COMPILE EXE #REGISTER NONE DEFLNG A-Z #INCLUDE "Win32Api.Inc" GLOBAL Finito& GLOBAL V AS LONG GLOBAL S AS STRING DECLARE FUNCTION fVKDDT DECLARE FUNCTION ClearDisp DECLARE CALLBACK FUNCTION DlgProc() %IDC_TEXT8 = 148 %IDC_TEXT9 = 149 %IDC_TEXT10 = 150 %IDC_LABEL1 = 200 %IDC_LABEL10 = 210 %IDC_LABEL11 = 211 %IDC_LABEL12 = 212 CALLBACK FUNCTION DlgProc AS LONG ' initialize scrollbar constants here LOCAL w AS LONG, vt AS LONG, ht AS LONG, hs AS LONG, vs AS LONG GLOBAL oldPos AS LONG, h AS LONG, si AS SCROLLINFO LOCAL Mes AS tagMsg ' Windows inherent sub classing (Look under MSG in Win32API-help) ' needed for the keyboard interception '========================================================================== 'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE 'SCROLL BARS: (try to experiment with these values) '========================================================================== w = 600 'This is the number of dialog units by which the Dialog's Window 'will scroll horizontaly if the thumb of the Scrolling Bar 'travels between its extreme positions left and right 'Reasonable (but not compulsory) value for it is between 200 to 2000 h = 400 'This is the number of dialog units by which the Dialog's Window 'will scroll verticaly if the thumb of the Scrolling Bar 'travels between its extreme positions top and bottom 'Reasonable (but not compulsory) value for it is between 200 to 1600 vt = 50 'lenght of the vertical scroll bar's thumb, this is also the amount 'of dialog units by which the dialog will scroll verticaly if mouse is 'clicked between the ends of the scroll bar and the thumb itself 'reasonable value for it is between 10 and h/2 ht = 50 'lenght of the horizontal scroling bar's thumb, this is also the amount 'of dialog units by which the dialog will scroll horizontaly if mouse is 'clicked between the ends of the scroll bar and the thumb itself 'reasonable value for it is between 10 and w/2 hs = 5 'number of dialog units by which the Dialog scrolls horizontaly when the 'small arrow on either end of scroling bar is activated by mouse 'reasonable values for it is between 1 and 30. Small value produces 'smother but slower scrolling, the higher value is faster but more 'jerki - the Dialog scrolls by steps determined by this value. vs = 5 'number of dialog units by which the Dialog scrolls verticaly when the 'small arrow on either end of scroling bar is activated by mouse 'reasonable values for it is between 1 and 30. Small value produces 'smother but slower scrolling, the higher value is faster but more 'jerki - the Dialog scrolls by steps determined by this value. '---------------- 'If scroling by dialog units and not by pixels is giving you stomachache 'remove REM from the next line. REM DIALOG UNITS CBHNDL, w, h TO PIXELS w, h '========================================================================== ' This is all you have to decide upon, the rest just copy. ' If you remove all comments, the code become quite lean! '========================================================================== SELECT CASE CBMSG CASE %WM_DESTROY : Finito = 1 : DIALOG END hDlg CASE %WM_INITDIALOG ' initialize scrollbars here '--------------------------------------------------------------------------------- si.cbSize = LEN(si) ' get place holders for the si parameters si.fMask = %SIF_ALL ' setting the topological space for the scroll bars si.nMin = 0 ' min scroll pos for thumb si.nMax = h ' max scroll pos for thumb si.nPage = vt ' lenght of the vertical scroll bar's thumb SetScrollInfo CBHNDL, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents ' "TRUE" and causes redraw of the scroll bar '-------------------------------------------------------------------------------- si.nMin = 0 ' min scroll pos for thumb si.nMax = w ' max scroll pos for thumb si.nPage = ht ' width of the horizontal scroll bar thumb si.nPos = 0 ' initial position of the thumbs SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents ' "TRUE" and causes redraw of the scroll bar '-------------------------------------------------------------------------------- CASE %WM_COMMAND ' <- a control is calling SELECT CASE CBCTL ' <- look at control's id IF CBCTLMSG = %BN_CLICKED THEN 'Enter key is beheaving here as the TAB key! SELECT CASE GetDlgCtrlId(GetFocus) 'Which control has focus? CASE %IDC_TEXT8 TO %IDC_TEXT10 IF (GetKeyState(%VK_SHIFT) AND &H8000) = 0 THEN 'move focus ' Is the above line another posibility to trap some keys? SetFocus GetNextDlgTabItem(CBHNDL, GetFocus, 0) ELSE 'Shift + Enter = move to previous control SetFocus GetNextDlgTabItem(CBHNDL, GetFocus, 1) END IF CASE %IDOK ' <- Ok or Enter key was pressed MSGBOX "%IDOK", %MB_TASKMODAL, "DDT Equate" ' your code here CASE %IDCANCEL ' If Cancel button has focus DIALOG END CBHNDL, 0 '<- End prog END SELECT END IF '---------------------------------------------- CASE %IDCANCEL ' <- Cancel button was pressed IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL, 0 '<- End prog END IF '-------------------------------------------------------------- ' END SELECT CASE %IDCANCEL IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog DIALOG END CBHNDL END IF END SELECT CASE %WM_HSCROLL ' call from the horizontal scroll bar si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_HORZ, si oldPos = si.nPos SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINELEFT : si.nPos = si.nPos - hs CASE %SB_PAGELEFT : si.nPos = si.nPos - si.nPage CASE %SB_LINERIGHT : si.nPos = si.nPos + hs CASE %SB_PAGERIGHT : si.nPos = si.nPos + si.nPage CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT 'To limit scroling range remove REM from the next line. 'If you don't then you can keep scrolling indefinitelly (well, almost) 'by using small arrrows on the end of the scroll bar. REM si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage)) ' Update the scroll bar and scroll the client area si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_HORZ, si, 1 'remember new geometry of the horizontal scroll bar ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL 'actual scroling action FUNCTION = 1 CASE %WM_VSCROLL 'call from the vertical scroll bar si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINEUP : si.nPos = si.nPos - vs CASE %SB_PAGEUP : si.nPos = si.nPos - si.nPage CASE %SB_LINEDOWN : si.nPos = si.nPos + vs CASE %SB_PAGEDOWN : si.nPos = si.nPos + si.nPage CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT 'To limit scroling range remove REM from the next line 'If you don't then you can keep scrolling indefinitelly (well, almost) 'by using small arrrows on the end of the scroll bar. REM si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage + 1)) ' Update the scroll bar and scroll the client area si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_VERT, si, 1 'remember new geometry of the vertical scroll bar ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL 'actual scroling action FUNCTION = 1 '=============================================================================================== ' Scrolling by Mouse wheel '=============================================================================================== CASE %WM_MBUTTONDOWN 'Use of the Middle Mouse Button (under the wheel) click as the toggle GLOBAL D AS LONG 'for the V/H scroling change IF D = 0 THEN D = 1 D= D*(-1) CASE %WM_MOUSEWHEEL ' LOCAL M AS LONG LOCAL K AS LONG ' If D = -1 THEN M = %SB_VERT Else M = %SB_HORZ ' Changing scrolling direction V/H IF HIWRD(CBWPARAM)> 50000 THEN K = 1 ELSE K = -1 'setting scrolling movement Up/Down, Left/Right IF D = -1 THEN si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos si.nPos = si.nPos +vs*3*K 'multiplied by 3 here to increase speed of scrolling - could be changed si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_VERT, si, 1 ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL FUNCTION = 1 ELSE si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_HORZ, si oldPos = si.nPos si.nPos = si.nPos +hs*3*K 'multiplied by 3 here to increase speed of scrolling - could be changed si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL FUNCTION = 1 END IF '=============================================================================================== ' Scrolling by Keyboard ( PgUp, PgDn) is done in the PBMAIN function (Dialog show MODELESS !!!) ' Scrolling using arrows is more complicated due to bizzare keyboard processing by Windows. ' On the other hand I think arrows are better left for use in conjunction with controls. '=============================================================================================== END SELECT END FUNCTION ________________________________________________________________________________________________________________ FUNCTION PBMAIN() GLOBAL hDlg AS DWORD DIALOG NEW 0, "Dialog's Scroling System & KeyBoard interception by M.Neyman",,, 450, 250, _ %WS_CAPTION OR %WS_SYSMENU OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX, TO hDlg DIALOG SET COLOR hDlg, -1, RGB(74, 164, 74) '------------------------------------------------------------------ CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !" + $CRLF + _ "Try also PgUp, PgDn keys and the Mouse wheel if you have Mouse with the wheel."+ $CRLF + _ "Please note, there is additional switch (button) under the Wheel." + $CRLF +_ "If you press hard the Wheel, the switch is activated (toggled) and the"+ $CRLF +_ "scrolling changes direction.", 100, 100, 300, 200 CONTROL SET COLOR hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74) CONTROL ADD TEXTBOX, hDlg, %IDC_TEXT8, "", 105, 225, 100, 13 CONTROL ADD LABEL, hDlg, %IDC_LABEL10, " Intercepted by:", 215, 215, 70, 12 CONTROL ADD LABEL, hDlg, -1, " %WM_KEYDOWN", 215, 227, 70, 10 CONTROL ADD TEXTBOX, hDlg, %IDC_TEXT10, "", 160, 208, 15, 13 CONTROL ADD LABEL, hDlg, -1, "Character", 115, 210, 40, 10 CONTROL ADD LABEL, hDlg, %IDC_LABEL12, " DDT EQUATE :", 310, 215, 70, 10 CONTROL ADD TEXTBOX, hDlg, %IDC_TEXT9, "", 295, 225, 100, 13 CONTROL SET COLOR hDlg, %IDC_LABEL12, %RED, -1 CONTROL ADD BUTTON, hDlg, %IDOK, "Ok", 192, 255, 50, 14 CONTROL ADD BUTTON, hDlg, %IDCANCEL, "&Cancel", 260, 255, 50, 14 DIALOG SHOW MODELESS hDlg CALL DlgProc '------------------------------------------------------------------ LOCAL Mes AS tagMsg ' Windows inherent sub classing (Win32API)! Look under MSG DO WHILE GetMessage(Mes, %NULL, 0, 0) SELECT CASE Mes.message '--------------------------- CASE %WM_CHAR CONTROL SET TEXT hDlg, %IDC_TEXT10, CHR$(Mes.wParam) Info6$ = "" CASE %WM_KEYDOWN SELECT CASE Mes.wParam CASE 27 Finito = 1 MSGBOX "You have pressed Escape key, the program will terminate" + _ $CRLF + $CRLF + " DDT Equate = %VK_ESCAPE, DEC = 27, HEX = 1B, " + _ $CRLF + $CRLF + " intercepted using %WM_KEYDOWN - Code Block 8" CASE 33 ScrollWindow hDlg, 0, oldPos + h, BYVAL %NULL, BYVAL %NULL 'Scroling up (jumping up ) by PageUp key V = Mes.wParam ' value for the translation into %VK_xxx equate CALL ClearDisp CONTROL SET TEXT hDlg, %IDC_TEXT8, Info8$ ' your code here CALL fVKDDT() ' your code here CONTROL SET TEXT hDlg, %IDC_TEXT9, S ' S = %VK_xxx equate derived from value of V (above) Info8$ = "" CASE 34 ScrollWindow hDlg, 0, oldPos - h, BYVAL %NULL, BYVAL %NULL 'Scroling down (jumping down ) by PageDown key V = Mes.wParam ' value for the translation into %VK_xxx equate CALL ClearDisp CONTROL SET TEXT hDlg, %IDC_TEXT8, Info8$ ' your code here CALL fVKDDT() ' your code here CONTROL SET TEXT hDlg, %IDC_TEXT9, S ' S = %VK_xxx equate derived from value of V (above) Info8$ = "" CASE 1 TO 255 : Info8$ =" DEC = " + STR$(Mes.wParam)+ " HEX = " + HEX$(Mes.wParam) 'interception of all keys V = Mes.wParam ' value for the translation into %VK_xxx equate CALL ClearDisp CONTROL SET TEXT hDlg, %IDC_TEXT8, Info8$ ' your code here CALL fVKDDT() ' your code here CONTROL SET TEXT hDlg, %IDC_TEXT9, S ' S = %VK_xxx equate derived from value of V (above) Info8$ = "" END SELECT END SELECT IF IsDialogMessage(hDlg, Mes) = %FALSE THEN TranslateMessage Mes DispatchMessage Mes END IF IF Finito <> 0 THEN EXIT DO LOOP END FUNCTION '_____________________________________________________________________________________________________________________________ '------------------------------------------- FUNCTION ClearDisp CONTROL SET TEXT hDlg, %IDC_TEXT8, "" CONTROL SET TEXT hDlg, %IDC_TEXT9, "" CONTROL SET TEXT hDlg, %IDC_TEXT10,"" END FUNCTION '============================================================================================================= '================================ FUNCTION fVKDDT 'placement of the DDT equates into array '-------------------------------- 'for the display purpose only. DIM VKDDT(255) AS STRING 'not important for your coding VKDDT(1) = "%VK_LBUTTON" VKDDT(2) = "%VK_RBUTTON" VKDDT(3) = "%VK_CANCEL" VKDDT(4) = "%VK_MBUTTON" VKDDT(5) = "%VK_XBUTTON1" VKDDT(6) = "%VK_XBUTTON2" VKDDT(8) = "%VK_BACK" VKDDT(9) = "%VK_TAB" VKDDT(10) = "%VK_LINEFEED" VKDDT(12) = "%VK_CLEAR" VKDDT(13) = "%VK_RETURN" VKDDT(16) = "%VK_SHIFT" VKDDT(17) = "%VK_CONTROL" VKDDT(18) = "%VK_MENU" VKDDT(19) = "%VK_PAUSE" VKDDT(20) = "%VK_CAPITAL" VKDDT(21) = "%VK_KANA " VKDDT(22) = "%VK_HANGUL" VKDDT(23) = "%VK_JUNJA" VKDDT(24) = "%VK_FINAL" VKDDT(25) = "%VK_HANJA" VKDDT(26) = "%VK_KANJI" VKDDT(27) = "%VK_ESCAPE" VKDDT(28) = "%VK_CONVERT" VKDDT(29) = "%VK_NONCONVERT" VKDDT(30) = "%VK_ACCEPT" VKDDT(31) = "%VK_MODECHANGE" VKDDT(32) = "%VK_SPACE" VKDDT(33) = "%VK_PGUP" VKDDT(34) = "%VK_NEXT" VKDDT(34) = "%VK_PGDN" VKDDT(35) = "%VK_END" VKDDT(36) = "%VK_HOME" VKDDT(37) = "%VK_LEFT" VKDDT(38) = "%VK_UP" VKDDT(39) = "%VK_RIGHT" VKDDT(40) = "%VK_DOWN " VKDDT(41) = "%VK_SELECT" VKDDT(42) = "%VK_PRINT" VKDDT(43) = "%VK_EXECUTE " VKDDT(44) = "%VK_SNAPSHOT" VKDDT(45) = "%VK_INSERT " VKDDT(46) = "%VK_DELETE " VKDDT(47) = "%VK_HELP " VKDDT(48) = "%VK_0" VKDDT(49) = "%VK_1" VKDDT(50) = "%VK_2" VKDDT(51) = "%VK_3" VKDDT(52) = "%VK_4" VKDDT(53) = "%VK_5" VKDDT(54) = "%VK_6" VKDDT(55) = "%VK_7" VKDDT(56) = "%VK_8" VKDDT(57) = "%VK_9" VKDDT(65) = "%VK_A" VKDDT(66) = "%VK_B" VKDDT(67) = "%VK_C" VKDDT(68) = "%VK_D" VKDDT(69) = "%VK_E" VKDDT(70) = "%VK_F" VKDDT(71) = "%VK_G" VKDDT(72) = "%VK_H" VKDDT(73) = "%VK_I" VKDDT(74) = "%VK_J" VKDDT(75) = "%VK_K" VKDDT(76) = "%VK_L" VKDDT(77) = "%VK_M" VKDDT(78) = "%VK_N" VKDDT(79) = "%VK_O" VKDDT(80) = "%VK_P" VKDDT(81) = "%VK_Q" VKDDT(82) = "%VK_R" VKDDT(83) = "%VK_S" VKDDT(84) = "%VK_T" VKDDT(85) = "%VK_U" VKDDT(86) = "%VK_V" VKDDT(87) = "%VK_W" VKDDT(88) = "%VK_X" VKDDT(89) = "%VK_Y" VKDDT(90) = "%VK_Z" VKDDT(91) = "%VK_LWIN" VKDDT(92) = "%VK_RWIN" VKDDT(93) = "%VK_APPS" VKDDT(95) = "%VK_SLEEP" VKDDT(96) = "%VK_NUMPAD0" VKDDT(97) = "%VK_NUMPAD1" VKDDT(98) = "%VK_NUMPAD2" VKDDT(99) = "%VK_NUMPAD3" VKDDT(100) = "%VK_NUMPAD4" VKDDT(101) = "%VK_NUMPAD5" VKDDT(102) = "%VK_NUMPAD6" VKDDT(103) = "%VK_NUMPAD7" VKDDT(104) = "%VK_NUMPAD8" VKDDT(105) = "%VK_NUMPAD9" VKDDT(106) = "%VK_MULTIPLY" VKDDT(107) = "%VK_ADD" VKDDT(108) = "%VK_SEPARATOR" VKDDT(109) = "%VK_SUBTRACT " VKDDT(110) = "%VK_DECIMAL " VKDDT(111) = "%VK_DIVIDE" VKDDT(112) = "%VK_F1" VKDDT(113) = "%VK_F2" VKDDT(114) = "%VK_F3" VKDDT(115) = "%VK_F4" VKDDT(116) = "%VK_F5" VKDDT(117) = "%VK_F6" VKDDT(118) = "%VK_F7" VKDDT(119) = "%VK_F8" VKDDT(120) = "%VK_F9" VKDDT(121) = "%VK_F10" VKDDT(122) = "%VK_F11" VKDDT(123) = "%VK_F12" VKDDT(124) = "%VK_F13" VKDDT(125) = "%VK_F14" VKDDT(126) = "%VK_F15" VKDDT(127) = "%VK_F16" VKDDT(128) = "%VK_F17" VKDDT(129) = "%VK_F18" VKDDT(130) = "%VK_F19" VKDDT(131) = "%VK_F20" VKDDT(132) = "%VK_F21" VKDDT(133) = "%VK_F22" VKDDT(134) = "%VK_F23" VKDDT(135) = "%VK_F24" VKDDT(144) = "%VK_NUMLOCK " VKDDT(145) = "%VK_SCROLL " VKDDT(146) = "%VK_OEM_NEC_EQUAL" VKDDT(147) = "%VK_OEM_FJ_MASSHOU" VKDDT(148) = "%VK_OEM_FJ_TOUROKU" VKDDT(149) = "%VK_OEM_FJ_LOYA" VKDDT(150) = "%VK_OEM_FJ_ROYA" VKDDT(160) = "%VK_LSHIFT" VKDDT(161) = "%VK_RSHIFT" VKDDT(162) = "%VK_LCONTROL" VKDDT(163) = "%VK_RCONTROL" VKDDT(164) = "%VK_LMENU" VKDDT(165) = "%VK_RMENU" VKDDT(166) = "%VK_BROWSER_BACK" VKDDT(167) = "%VK_BROWSER_FORWARD" VKDDT(168) = "%VK_BROWSER_REFRESH" VKDDT(169) = "%VK_BROWSER_STOP" VKDDT(170) = "%VK_BROWSER_SEARCH " VKDDT(171) = "%VK_BROWSER_FAVORITES" VKDDT(172) = "%VK_BROWSER_HOME" VKDDT(173) = "%VK_VOLUME_MUTE" VKDDT(174) = "%VK_VOLUME_DOWN" VKDDT(175) = "%VK_VOLUME_UP" VKDDT(176) = "%VK_MEDIA_NEXT_TRACK" VKDDT(177) = "%VK_MEDIA_PREV_TRACK" VKDDT(178) = "%VK_MEDIA_STOP" VKDDT(179) = "%VK_MEDIA_PLAY_PAUSE " VKDDT(180) = "%VK_LAUNCH_MAIL" VKDDT(181) = "%VK_LAUNCH_MEDIA_SELECT" VKDDT(182) = "%VK_LAUNCH_APP1" VKDDT(183) = "%VK_LAUNCH_APP2" VKDDT(186) = "%VK_OEM_1" VKDDT(187) = "%VK_OEM_PLUS" VKDDT(188) = "%VK_OEM_COMMA" VKDDT(189) = "%VK_OEM_MINUS" VKDDT(190) = "%VK_OEM_PERIOD" VKDDT(191) = "%VK_OEM_2" VKDDT(192) = "%VK_OEM_3" VKDDT(219) = "%VK_OEM_4" VKDDT(220) = "%VK_OEM_5" VKDDT(221) = "%VK_OEM_6 " VKDDT(222) = "%VK_OEM_7" VKDDT(223) = "%VK_OEM_8" VKDDT(225) = "%VK_OEM_AX" VKDDT(226) = "%VK_OEM_102" VKDDT(227) = "%VK_ICO_HELP" VKDDT(228) = "%VK_ICO_00" VKDDT(229) = "%VK_PROCESSKEY" VKDDT(230) = "%VK_ICO_CLEAR" VKDDT(231) = "%VK_PACKET" VKDDT(233) = "%VK_OEM_RESET" VKDDT(234) = "%VK_OEM_JUMP" VKDDT(235) = "%VK_OEM_PA1" VKDDT(236) = "%VK_OEM_PA2 " VKDDT(237) = "%VK_OEM_PA3 " VKDDT(238) = "%VK_OEM_WSCTRL" VKDDT(239) = "%VK_OEM_CUSEL" VKDDT(240) = "%VK_OEM_ATTN" VKDDT(241) = "%VK_OEM_FINISH" VKDDT(242) = "%VK_OEM_COPY" VKDDT(243) = "%VK_OEM_AUTO" VKDDT(244) = "%VK_OEM_ENLW" VKDDT(245) = "%VK_OEM_BACKTAB" VKDDT(246) = "%VK_ATTN" VKDDT(247) = "%VK_CRSEL" VKDDT(248) = "%VK_EXSEL" VKDDT(249) = "%VK_EREOF" VKDDT(250) = "%VK_PLAY " VKDDT(251) = "%VK_ZOOM " VKDDT(252) = "%VK_NONAME" VKDDT(253) = "%VK_PA1" VKDDT(254) = "%VK_OEM_CLEAR" S = VKDDT(V) END FUNCTION '======================================= [This message has been edited by Maciej NEYMAN (edited April 25, 2006).]
|
|
#4
Apr 25th, 2006, 07:51 AM
|
|||
|
|||
|
And this is basic Skeleton Code of the Dialog with the working Scrolling system:
Code:
'======================================================================= ' Minimum Skeleton sample for Dialog with the Scrolling Bars ' by Maciej Neyman. ' 'Disclaimer: 'This code is provided as-is and it does not have any warranty of any kind. 'If it causes collapse of the Universe, the Author does not want to know it. 'Refer that case to Inteligent Designer and blame Billy G. for it. ' 'User is responsible for any use and/or misuse of the code. 'If you don't agree please don't use this code. '===================================================================== #COMPILE EXE #REGISTER NONE DEFLNG A-Z #INCLUDE "Win32Api.Inc" GLOBAL Finito& GLOBAL V AS LONG GLOBAL S AS STRING DECLARE FUNCTION fVKDDT DECLARE FUNCTION ClearDisp DECLARE CALLBACK FUNCTION DlgProc() %IDC_LABEL1 = 200 '=================================================== CALLBACK FUNCTION DlgProc AS LONG ' initialize scrollbar constants here LOCAL w AS LONG, vt AS LONG, ht AS LONG, hs AS LONG, vs AS LONG GLOBAL oldPos AS LONG, h AS LONG, si AS SCROLLINFO LOCAL Mes AS tagMsg ' Windows inherent sub classing (Look under MSG in Win32API-help) ' needed for the keyboard interception '========================================================================== 'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE 'SCROLL BARS: (try to experiment with these values) '========================================================================== w = 600 'This is the number of dialog units by which the Dialog's Window 'will scroll horizontaly if the thumb of the Scrolling Bar 'travels between its extreme positions left and right 'Reasonable (but not compulsory) value for it is between 200 to 2000 h = 400 'This is the number of dialog units by which the Dialog's Window 'will scroll verticaly if the thumb of the Scrolling Bar 'travels between its extreme positions top and bottom 'Reasonable (but not compulsory) value for it is between 200 to 1600 vt = 50 'lenght of the vertical scroll bar's thumb, this is also the amount 'of dialog units by which the dialog will scroll verticaly if mouse is 'clicked between the ends of the scroll bar and the thumb itself 'reasonable value for it is between 10 and h/2 ht = 50 'lenght of the horizontal scroling bar's thumb, this is also the amount 'of dialog units by which the dialog will scroll horizontaly if mouse is 'clicked between the ends of the scroll bar and the thumb itself 'reasonable value for it is between 10 and w/2 hs = 5 'number of dialog units by which the Dialog scrolls horizontaly when the 'small arrow on either end of scroling bar is activated by mouse 'reasonable values for it is between 1 and 30. Small value produces 'smother but slower scrolling, the higher value is faster but more 'jerki - the Dialog scrolls by steps determined by this value. vs = 5 'number of dialog units by which the Dialog scrolls verticaly when the 'small arrow on either end of scroling bar is activated by mouse 'reasonable values for it is between 1 and 30. Small value produces 'smother but slower scrolling, the higher value is faster but more 'jerki - the Dialog scrolls by steps determined by this value. '---------------- 'If scroling by dialog units and not by pixels is giving you stomachache 'remove REM from the next line. REM DIALOG UNITS CBHNDL, w, h TO PIXELS w, h '========================================================================== ' This is all you have to decide upon, the rest just copy. ' If you remove all comments, the code become quite lean! '========================================================================== SELECT CASE CBMSG CASE %WM_DESTROY : Finito = 1 : DIALOG END hDlg CASE %WM_INITDIALOG ' initialize scrollbars here '--------------------------------------------------------------------------------- si.cbSize = LEN(si) ' get place holders for the si parameters si.fMask = %SIF_ALL ' setting the topological space for the scroll bars si.nMin = 0 ' min scroll pos for thumb si.nMax = h ' max scroll pos for thumb si.nPage = vt ' lenght of the vertical scroll bar's thumb SetScrollInfo CBHNDL, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents ' "TRUE" and causes redraw of the scroll bar '-------------------------------------------------------------------------------- si.nMin = 0 ' min scroll pos for thumb si.nMax = w ' max scroll pos for thumb si.nPage = ht ' width of the horizontal scroll bar thumb si.nPos = 0 ' initial position of the thumbs SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents ' "TRUE" and causes redraw of the scroll bar '-------------------------------------------------------------------------------- CASE %IDCANCEL IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog DIALOG END CBHNDL END IF CASE %WM_HSCROLL ' call from the horizontal scroll bar si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_HORZ, si oldPos = si.nPos SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINELEFT : si.nPos = si.nPos - hs CASE %SB_PAGELEFT : si.nPos = si.nPos - si.nPage CASE %SB_LINERIGHT : si.nPos = si.nPos + hs CASE %SB_PAGERIGHT : si.nPos = si.nPos + si.nPage CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT 'To limit scroling range remove REM from the next line. 'If you don't then you can keep scrolling indefinitelly (well, almost) 'by using small arrrows on the end of the scroll bar. REM si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage)) ' Update the scroll bar and scroll the client area si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_HORZ, si, 1 'remember new geometry of the horizontal scroll bar ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL 'actual scroling action FUNCTION = 1 CASE %WM_VSCROLL 'call from the vertical scroll bar si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINEUP : si.nPos = si.nPos - vs CASE %SB_PAGEUP : si.nPos = si.nPos - si.nPage CASE %SB_LINEDOWN : si.nPos = si.nPos + vs CASE %SB_PAGEDOWN : si.nPos = si.nPos + si.nPage CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM) CASE ELSE : EXIT FUNCTION END SELECT 'To limit scroling range remove REM from the next line 'If you don't then you can keep scrolling indefinitelly (well, almost) 'by using small arrrows on the end of the scroll bar. REM si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage + 1)) ' Update the scroll bar and scroll the client area si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_VERT, si, 1 'remember new geometry of the vertical scroll bar ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL 'actual scroling action FUNCTION = 1 '=============================================================================================== ' Scrolling by Mouse wheel '=============================================================================================== CASE %WM_MBUTTONDOWN 'Use of the Middle Mouse Button (under the wheel) click as the toggle GLOBAL D AS LONG 'for the V/H scroling change IF D = 0 THEN D = 1 D= D*(-1) CASE %WM_MOUSEWHEEL ' LOCAL M AS LONG LOCAL K AS LONG ' If D = -1 THEN M = %SB_VERT Else M = %SB_HORZ ' Changing scrolling direction V/H IF HIWRD(CBWPARAM)> 50000 THEN K = 1 ELSE K = -1 'setting scrolling movement Up/Down, Left/Right IF D = -1 THEN si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_VERT, si oldPos = si.nPos si.nPos = si.nPos +vs*3*K 'multiplied by 3 here to increase speed of scrolling - could be changed si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_VERT, si, 1 ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL FUNCTION = 1 ELSE si.cbSize = SIZEOF(si) si.fMask = %SIF_ALL GetScrollInfo CBHNDL, %SB_HORZ, si oldPos = si.nPos si.nPos = si.nPos +hs*3*K 'multiplied by 3 here to increase speed of scrolling - could be changed si.fMask = %SIF_POS SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL FUNCTION = 1 END IF '=============================================================================================== ' Scrolling by Keyboard ( PgUp, PgDn) is done in the PBMAIN function (Dialog show MODELESS !!!) ' Scrolling using arrows is more complicated due to bizzare keyboard processing by Windows. ' On the other hand I think arrows are better left for use in conjunction with controls. '=============================================================================================== END SELECT END FUNCTION ________________________________________________________________________________________________________________ FUNCTION PBMAIN() GLOBAL hDlg AS DWORD DIALOG NEW 0, "Skeleton Dialog with Scroling bars by Maciej Neyman",,, 450, 250, _ %WS_CAPTION OR %WS_SYSMENU OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX, TO hDlg DIALOG SET COLOR hDlg, -1, RGB(74, 164, 74) '------------------------------------------------------------------ CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !" + $CRLF + _ "Try also PgUp, PgDn keys and the Mouse wheel if you have Mouse with the wheel."+ $CRLF + _ "Please note, there is additional switch (button) under the Wheel." + $CRLF +_ "If you press hard the Wheel, the switch is activated (toggled) and the"+ $CRLF +_ "scrolling changes direction.", 100, 100, 300, 200 CONTROL SET COLOR hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74) DIALOG SHOW MODELESS hDlg CALL DlgProc '------------------------------------------------------------------ LOCAL Mes AS tagMsg ' Windows inherent sub classing (Win32API)! Look under MSG DO WHILE GetMessage(Mes, %NULL, 0, 0) SELECT CASE Mes.message '--------------------------- CASE %WM_KEYDOWN SELECT CASE Mes.wParam CASE 27 Finito = 1 CASE 33 ScrollWindow hDlg, 0, oldPos + h, BYVAL %NULL, BYVAL %NULL 'Scroling up (jumping up ) by PageUp key CASE 34 ScrollWindow hDlg, 0, oldPos - h, BYVAL %NULL, BYVAL %NULL 'Scroling down (jumping down ) by PageDown key END SELECT END SELECT IF IsDialogMessage(hDlg, Mes) = %FALSE THEN TranslateMessage Mes DispatchMessage Mes END IF IF Finito <> 0 THEN EXIT DO LOOP END FUNCTION '__________________________________________________________ 'Enjoy M.N. Code cleaned up now from inadvertend debris! Sorry. [This message has been edited by Maciej NEYMAN (edited April 25, 2006).]
|
|
| Thread Tools | |
| Display Modes | |
|
|
Linear Mode
