Tweet
Some people have asked me for just a stand alone code to demo the Scrollable ViewPort
that was in the previous post for Borje Hagsten Open Picture Dialog. So here it is...
Regards, Jules
[This message has been edited by Jules Marchildon (edited October 27, 2000).]
that was in the previous post for Borje Hagsten Open Picture Dialog. So here it is...
Regards, Jules
Code:
'----------------------------------------------------------------------------- ' Scrollable ViewPort Example ' ' By Jules Marchildon, [url="mailto:[email protected]"]mailto:[email protected][/url][email protected]</A> ' October 27, 2000 ' '----------------------------------------------------------------------------- $COMPILE EXE $INCLUDE "WIN32API.INC" '--- GLOBAL ghInst AS LONG GLOBAL ghMain AS LONG GLOBAL ghViewPort AS LONG 'window we want to scroll GLOBAL ghViewScroll AS LONG 'window used to scroll ghViewPort GLOBAL gEndptX AS LONG GLOBAL gEndptY AS LONG '----------------------------------------------------------------------------- ' ' ' '------------------------------------------------------------------------------ FUNCTION WINMAIN(BYVAL hInstance AS LONG, _ BYVAL hPrevInstance AS LONG, _ lpszCmdLine AS ASCIIZ PTR, _ BYVAL nCmdShow AS LONG) AS LONG LOCAL hwnd AS LONG LOCAL Msg AS tagMSG LOCAL wcl AS WNDCLASSEX LOCAL szWinName AS ASCIIZ*20 'Register the Main application window IF ISFALSE(hPrevInstance) THEN szWinName ="MyWin" wcl.cbSize = sizeof(wcl) wcl.hInstance = hInstance wcl.lpszClassName = varptr(szWinName) wcl.lpfnWndProc = codeptr(MainWindowProc) wcl.style = 0 wcl.hIcon = LoadIcon(hInstance, BYVAL %IDI_APPLICATION) wcl.hIconSm = %NULL wcl.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) wcl.hbrBackground = GetStockObject(%WHITE_BRUSH) wcl.cbClsExtra = 0 wcl.cbWndExtra = 0 wcl.lpszMenuName = %NULL RegisterClassEx wcl ELSE EXIT FUNCTION END IF '--- ghInst = hInstance '--- 'Create the Main window hwnd = CreateWindowEx(0,szWinName, _ "Scrollable ViewPort", _ %WS_OVERLAPPEDWINDOW, _ %CW_USEDEFAULT, %CW_USEDEFAULT, _ %CW_USEDEFAULT, %CW_USEDEFAULT, _ %NULL, %NULL, ghInst, BYVAL %NULL) ShowWindow hWnd, %SW_SHOW UpdateWindow hWnd ghMain = hWnd Call SetFocus(ghViewScroll) WHILE GetMessage(Msg, %NULL, 0, 0) TranslateMessage Msg DispatchMessage Msg WEND FUNCTION = Msg.wParam END FUNCTION '------------------------------------------------------------------------ ' Main window callback procedure. ' ' Creates the scrolling veiw port window holder ' '------------------------------------------------------------------------ FUNCTION MainWindowProc(BYVAL hWnd AS LONG, _ BYVAL Msg AS LONG,BYVAL wParam AS LONG, _ BYVAL lParam AS LONG) AS LONG '--- SELECT CASE Msg CASE %WM_CREATE dim szWinName as asciiz*25 dim wcl AS WNDCLASSEX szWinName ="VIEWSCROLL" wcl.cbSize = sizeof(wcl) wcl.hInstance = ghInst wcl.lpszClassName = varptr(szWinName) wcl.lpfnWndProc = codeptr(ViewScrollProc) wcl.style = 0 wcl.hIcon = LoadIcon(ghInst, BYVAL %IDI_APPLICATION) wcl.hIconSm = %NULL wcl.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) wcl.hbrBackground = GetStockObject(%WHITE_BRUSH) wcl.cbClsExtra = 0 wcl.cbWndExtra = 0 wcl.lpszMenuName = %NULL RegisterClassEx wcl ghViewScroll& = CreateWindowEx(0,"VIEWSCROLL", _ "", _ %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER, _ 100,100, _ 600, 200, _ hWnd, %NULL, ghInst, BYVAL %NULL) Function = 0 Exit Function CASE %WM_SETFOCUS Call SetFocus(ghViewScroll) Function = 0 Exit Function CASE %WM_DESTROY PostQuitMessage 0 CASE ELSE FUNCTION= DefWindowProc(hwnd, Msg, wParam, lParam) EXIT FUNCTION END SELECT FUNCTION = 0 END FUNCTION '------------------------------------------------------------------------ ' View Port Holder callback procedure: ' ' This is the window holder for our scrolling window. This is also our ' scrollbar handler. Note: this window needs the keyboard focus if you ' want to use the keyboard to scroll. ' ' The WM_SIZE handler will adjust the scrollbar range if the ViewPort ' holder(ViewScroll) has a Sizing Border. '------------------------------------------------------------------------ FUNCTION ViewScrollProc(BYVAL hWnd AS LONG, _ BYVAL Msg AS LONG,BYVAL wParam AS LONG, _ BYVAL lParam AS LONG) AS LONG LOCAL hdc AS LONG LOCAL ps AS PAINTSTRUCT LOCAL tm AS TEXTMETRIC LOCAL str AS ASCIIZ*255 LOCAL str2 AS ASCIIZ*255 LOCAL i AS INTEGER LOCAL inc AS INTEGER LOCAL X AS INTEGER 'current output location LOCAL Y AS INTEGER LOCAL hbrush AS LONG 'handle to virtual window brush STATIC maxX AS INTEGER 'screen dimensions STATIC maxY AS INTEGER STATIC orgX AS INTEGER 'origin for current display STATIC orgY AS INTEGER STATIC si AS SCROLLINFO STATIC memdc AS LONG 'handle to virtual window context STATIC hbit AS LONG 'handle to virtual window bitmap STATIC curdim AS RECT 'current size of physical window '--- SELECT CASE Msg CASE %WM_CREATE 'get screen coordinates maxX = GetSystemMetrics(%SM_CXSCREEN) maxY = GetSystemMetrics(%SM_CYSCREEN) 'create a window that is larger 'maxX = maxX *2 'maxY = maxY *2 'save our end points for use later gEndptX = maxX gEndptY = maxY 'initialize scroll bar ranges GetClientRect hwnd, curdim si.cbSize = sizeof(si) si.fMask = %SIF_RANGE si.nMin = 0 si.nMax = maxX -curdim.nRight SetScrollInfo hwnd, %SB_HORZ, si, 1 si.nMax = maxY -curdim.nBottom SetScrollInfo hwnd, %SB_VERT, si, 1 dim szWinName as asciiz*25 dim wcl AS WNDCLASSEX szWinName ="VIEWPORT" wcl.cbSize = sizeof(wcl) wcl.hInstance = ghInst wcl.lpszClassName = varptr(szWinName) wcl.lpfnWndProc = codeptr(ViewPortProc) wcl.style = 0 wcl.hIcon = LoadIcon(ghInst, BYVAL %IDI_APPLICATION) wcl.hIconSm = %NULL wcl.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW) wcl.hbrBackground = GetStockObject(%WHITE_BRUSH) wcl.cbClsExtra = 0 wcl.cbWndExtra = 0 wcl.lpszMenuName = %NULL RegisterClassEx wcl ghViewPort& = CreateWindowEx(0,"VIEWPORT", _ "", _ %WS_CHILD OR %WS_VISIBLE , _ 0,0, _ maxX, maxY, _ hWnd, %NULL, ghInst, BYVAL %NULL) '------------------------IMPORTANT NOTE-------------------------------- ' ' Needs keyboard focus ! '---------------------------------------------------------------------- CASE %WM_KEYDOWN SELECT CASE LOWRD(wParam) CASE %VK_HOME SendMessage hWnd,%WM_VSCROLL,%SB_TOP,0 SendMessage hWnd,%WM_HSCROLL,%SB_TOP,0 CASE %VK_END SendMessage hWnd,%WM_VSCROLL,%SB_BOTTOM,0 SendMessage hWnd,%WM_HSCROLL,%SB_BOTTOM,0 CASE %VK_RIGHT IF GetKeyState(%VK_CONTROL) < 0 THEN 'if Ctrl+Right SendMessage hWnd,%WM_HSCROLL,%SB_PAGERIGHT,0 ELSE SendMessage hWnd,%WM_HSCROLL,%SB_LINERIGHT,0 END IF CASE %VK_LEFT IF GetKeyState(%VK_CONTROL) < 0 THEN 'if Ctrl+Left SendMessage hWnd,%WM_HSCROLL,%SB_PAGELEFT,0 ELSE SendMessage hWnd,%WM_HSCROLL,%SB_LINELEFT,0 END IF CASE %VK_DOWN SendMessage hWnd,%WM_VSCROLL,%SB_LINEDOWN,0 CASE %VK_UP SendMessage hWnd,%WM_VSCROLL,%SB_LINEUP,0 CASE %VK_PGDN SendMessage hWnd,%WM_VSCROLL,%SB_PAGEDOWN,0 CASE %VK_PGUP SendMessage hWnd,%WM_VSCROLL,%SB_PAGEUP,0 END SELECT '------------------------------------------------------------------------------- ' Scroll Bar handler ' '------------------------------------------------------------------------------- CASE %WM_HSCROLL SELECT CASE LOWRD(wParam) CASE %SB_THUMBTRACK orgX = HIWRD(wParam) CASE %SB_LINERIGHT IF orgX < maxX-curdim.nRight THEN orgX= orgX+10 CASE %SB_LINELEFT IF orgX > 0 THEN orgX= orgX -10 CASE %SB_PAGERIGHT IF orgX+50 < maxX-curdim.nRight THEN orgX=orgX +50 Else orgX = maxX -curdim.nRight CASE %SB_PAGELEFT IF orgX-50 > 0 THEN orgX=orgX -50 Else orgX=0 CASE %SB_TOP orgX = 0 CASE %SB_BOTTOM orgX = maxX -curdim.nRight END SELECT si.fMask = %SIF_POS si.nPos = orgX SetScrollInfo hwnd, %SB_HORZ, si, 1 Call MoveWindow(ghViewPort,-orgX,-orgY,maxX,maxY,%TRUE) Function = 0 Exit Function CASE %WM_VSCROLL SELECT CASE LOWRD(wParam) CASE %SB_THUMBTRACK orgY = HIWRD(wParam) CASE %SB_LINEDOWN IF orgY < maxY-curdim.nBottom THEN orgY = orgY +10 CASE %SB_LINEUP IF orgY > 0 THEN orgY = orgY -10 CASE %SB_PAGEDOWN IF orgY+50 < maxY-curdim.nBottom THEN orgY = orgY +50 Else orgY = maxY -curdim.nBottom CASE %SB_PAGEUP IF orgY-50 > 0 THEN orgY = orgY -50 Else orgY = 0 CASE %SB_TOP orgY = 0 CASE %SB_BOTTOM orgY = maxY -curdim.nBottom END SELECT si.fMask = %SIF_POS si.nPos = orgY SetScrollInfo hwnd, %SB_VERT, si, 1 Call MoveWindow(ghViewPort,-orgX,-orgY,maxX,maxY,%TRUE) Function = 0 Exit Function '--- CASE %WM_SIZE 'update virtual window origins if window size increasing inc = HIWRD(lParam)-curdim.nBottom IF(inc > 0) AND (orgY >= (maxY-curdim.nBottom)) THEN orgY= orgY -inc IF orgY < 0 THEN orgY = 0 inc = LOWRD(lParam)-curdim.nRight IF (inc > 0) AND (orgX >= (maxX-curdim.nRight)) THEN orgX = orgX -inc IF orgX < 0 THEN orgX = 0 'store new window extents curdim.nRight = LOWRD(lParam) curdim.nBottom = HIWRD(lParam) 'reinitialize scroll bar ranges si.cbSize = sizeof(si) si.fMask = %SIF_RANGE OR %SIF_POS si.nMin = 0 si.nMax = maxX-curdim.nRight si.nPos = orgX SetScrollInfo hwnd, %SB_HORZ, si, 1 si.nMax = maxY-curdim.nBottom si.nPos = orgY SetScrollInfo hwnd, %SB_VERT, si, 1 CASE %WM_DESTROY CASE ELSE FUNCTION= DefWindowProc(hwnd, Msg, wParam, lParam) EXIT FUNCTION END SELECT FUNCTION = 0 END FUNCTION '----------------------------------------------------------------------- ' This is the window we are scolling and the one we paint things on. ' ' '----------------------------------------------------------------------- FUNCTION ViewPortProc(BYVAL hWnd AS LONG, _ BYVAL Msg AS LONG,BYVAL wParam AS LONG, _ BYVAL lParam AS LONG) AS LONG LOCAL hDC AS LONG LOCAL ps AS PAINTSTRUCT LOCAL hbrush AS LONG '--- SELECT CASE Msg CASE %WM_CREATE 'test with a couple of button controls... hWndNew& =CreateWindowEx(0,"BUTTON", "&Button", _ %WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS _ OR %BS_PUSHBUTTON, _ 100, _ 100, _ 100, _ 30, _ hWnd, BYVAL %NULL, ghInst, ByVal %NULL) hWndNew& =CreateWindowEx(0,"BUTTON", "&Button", _ %WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS _ OR %BS_PUSHBUTTON, _ gEndptX\2, _ gEndptY\2, _ 100, _ 30, _ hWnd, BYVAL %NULL, ghInst, ByVal %NULL) CASE %WM_PAINT 'test with a couple of objects... hdc = BeginPaint(hwnd, ps) hIcon& = LoadIcon(%NULL,BYVAL %IDI_EXCLAMATION) Call DrawIcon(hDC,0,0,hIcon&) Call DrawIcon(hDC,gEndptX-32,gEndptY-32,hIcon&) hIcon& = LoadIcon(%NULL,BYVAL %IDI_HAND) Call DrawIcon(hDC,0,gEndptY-32,hIcon&) Call DrawIcon(hDC,gEndptX-32,0,hIcon&) EndPaint hwnd, ps '--- CASE %WM_SIZE CASE %WM_SETFOCUS Call SetFocus(ghViewScroll) Function = 0 Exit Function CASE %WM_DESTROY CASE ELSE FUNCTION= DefWindowProc(hwnd, Msg, wParam, lParam) EXIT FUNCTION END SELECT FUNCTION = 0 END FUNCTION
[This message has been edited by Jules Marchildon (edited October 27, 2000).]
Comment