Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Graphic Window scrolling

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Graphic Window scrolling

    This test code was prompted by the discussion at http://www.powerbasic.com/support/pb...ad.php?t=40223

    Normally a Graphic Window doesn't have scroll bars but where there's a will...
    Code:
    #Dim All
    #Include "win32API.inc"
     
    Global hHook???
    Function HookGFXWindow(ByVal lMsg As Dword, ByVal wParam As Dword, ByVal lParam As Long) As Long
      If lMsg = %HCBT_CREATEWND Then                    ' wParam = handle of Window about to be created
        UnhookWindowsHookEx hHook
        SetWindowLong wParam, %GWL_STYLE, (GetWindowLong (wParam, %GWL_STYLE) Or %WS_VScroll Or %WS_HScroll)
      End If
     Function = 0
    End Function
    '------------------/HookGFXWindow
     
    Function GWProc(ByVal hWnd As Dword, ByVal wMsg As Dword, _
                    ByVal wParam As Dword, ByVal lParam As Long) As Long
     Local  oldProc As Dword
     Static hBmp    As Dword
     Static GW      As Rect
     Static BmpSz, GWSz, siLn As POINTAPI
     Static hsi As SCROLLINFO, vsi As SCROLLINFO
     
      Select Case As Long wMsg
        Case %WM_User + 1000
          GetClientRect hWnd, GW                        ' Get Graphic Window size
          GWSz.x = GW.nRight : GWSz.y = GW.nBottom
          hBmp  = wParam                                ' BitMap Handle and Size (passed from PBMain)
          BmpSz.x = Lo(Word, lParam) : BmpSz.y = Hi(Word, lParam)
     
          siLn.X = 0.1 * GWSz.x ' 10% of page           ' define 'line width' ie move increment
          siLn.Y = 0.1 * GWSz.y ' 10% of page
     
          hsi.cbsize = SizeOf(hsi)
          hsi.nMin   = 0
          hsi.nPage  = GWSz.x
          hsi.fMask  = %SIF_All '%SIF_Range Or %SIF_Page
          hsi.nMax   = BmpSz.x
          SetScrollInfo hWnd, %SB_Horz, hsi, 1          ' initialize Horizontal ScrollInfo structure
     
          vsi = hsi
          vsi.nPage  = GWSz.y
          vsi.nMax   = BmpSz.y
          SetScrollInfo hWnd, %SB_Vert, vsi, 1          ' initialize Vertical ScrollInfo structure
     
          Graphic Attach hWnd, 0
          Graphic Copy hBmp, 0, (hsi.nPos, vsi.nPos)-(hsi.nPos + GWSz.x-1, vsi.nPos + GWSz.y-1) To (0,0)
     
        Case %WM_HScroll
          Select Case Lo(Word, wParam)
            Case %SB_LineLeft   : hsi.nPos = hsi.nPos - siLn.X
            Case %SB_lineright  : hsi.nPos = hsi.nPos + siLn.X
            Case %SB_PageLeft   : hsi.nPos = hsi.nPos - GWSz.x
            Case %SB_PageRight  : hsi.nPos = hsi.nPos + GWSz.x
            Case %SB_Left       : hsi.nPos = 0
            Case %SB_Right      : hsi.nPos = BmpSz.x - GWSz.x
            Case %SB_ThumbTrack : hsi.nPos = Hi(Word, wParam)
            Case Else           : Exit Function
          End Select
          hsi.nPos = Max(hsi.nPos, 0): hsi.nPos = Min(hsi.nPos, BmpSz.x - GWSz.x)
          hsi.fMask = %SIF_Pos
          SetScrollInfo hWnd, %SB_Horz, hsi, 1
     
          Graphic Attach hWnd, 0
          Graphic Copy hBmp, 0, (hsi.nPos, vsi.nPos)-(hsi.nPos + GWSz.x-1, vsi.nPos + GWSz.y-1) To (0,0)
     
        Case %WM_VScroll
          Select Case Lo(Word, wParam)
            Case %SB_LineUp     : vsi.nPos = vsi.nPos - siLn.Y
            Case %SB_LineDown   : vsi.nPos = vsi.nPos + siLn.Y
            Case %SB_PageUp     : vsi.nPos = vsi.nPos - GWSz.y
            Case %SB_PageDown   : vsi.nPos = vsi.nPos + GWSz.y
            Case %SB_ThumbTrack : vsi.nPos = Hi(Word, wParam)
            Case Else           : Exit Function
          End Select
          vsi.nPos = Max(vsi.nPos, 0): vsi.nPos = Min(vsi.nPos, BmpSz.y - GWSz.y)
          vsi.fMask = %SIF_Pos
          SetScrollInfo hWnd, %SB_Vert, vsi, 1
     
          Graphic Attach hWnd, 0
          Graphic Copy hBmp, 0, (hsi.nPos, vsi.nPos)-(hsi.nPos + GWSz.x-1, vsi.nPos + GWSz.y-1) To (0,0)
     
        Case %WM_MouseWheel
         Local zDelta As Integer
          zDelta = Hi(Word, wParam)
     
          If (Lo(Word, wParam) And %MK_CONTROL) = %MK_CONTROL Then  ' horizontal scroll (Ctrl key down)
            If zDelta > 0 Then                                      ' scroll to the left
              SendMessage hWnd, %WM_HScroll, Mak(Long, %SB_LineLeft, 0), 0
            Else                                                    ' scroll to the right
              SendMessage hWnd, %WM_HScroll, Mak(Long, %SB_lineright, 0), 0
            End If
          Else                                                      ' vertical scroll
            If zDelta > 0 Then                                      ' scroll upwards
              SendMessage hWnd, %WM_VScroll, Mak(Long, %SB_LineUp, 0), 0
            Else                                                    ' scroll downwards
              SendMessage hWnd, %WM_VScroll, Mak(Long, %SB_LineDown, 0), 0
            End If
          End If
     
      End Select
     oldProc  = GetProp (hWnd, "OldGWProc")
     Function = CallWindowProc(oldProc, hWnd, wMsg, wParam, lParam)
    End Function
    '------------------/GWProc
     
    Function PBMain() As Long
     Local BmpSz        As PointAPI
     Local hBmp, hGWin  As Dword
     Local xSize&, ySize&, ImageFile$, nFile&, k$
     
      xSize& = 400 : ySize& = 400                       ' Graphic Window size
     
      ImageFile$ = ".\trees.bmp"  ' <<- select an image bigger than the window for scrolling to work.
      nFile& = FreeFile
      Open ImageFile$ For Binary Access Read As nFile&  ' get the size of the image
        Get #nFile&, 19, BmpSz.x
        Get #nFile&, 23, BmpSz.y
      Close nFile&
     
      ' Create a Graphic Bitmap and load the image
      Graphic Bitmap Load ImageFile$, BmpSz.x, BmpSz.y To hBmp
     
      ' create a window to display the part image in the screen (hook it to add scrollbars)
      hHook = SetWindowsHookEx(%WH_CBT, CodePtr(HookGFXWindow), GetModuleHandle(""), 0)
      Graphic Window "Test - Graphic Window scrolling", 200, 200, ySize&, xSize& To hGWin
     
      ' SubClass the GW to get access to scroll info
      SetProp hGWin, "OldGWProc", SetWindowLong(hGWin, %GWL_WNDPROC, CodePtr(GWProc))
     
      ' Pass hBmp and size to GWProc, set up SCROLLINFO structures
      PostMessage hGWin, %WM_User + 1000, hBmp, Mak(Long, BmpSz.x, BmpSz.y)
     
      Graphic Attach hGWin, 0
      Graphic Print "No bitmap loaded"
     
      While IsWin(hGWin)
        Graphic InKey$ To k$                            ' Capture arrow keys etc
        Select Case Len(k$)
          Case 0                                        ' No keys pressed
            Dialog DoEvents
          Case 1                                        ' ASCII Key pressed
            If k$ = $Esc Or k$="q" Or k$="Q" Then
              Exit Loop
            End If
          Case 2                                        ' Extended key pressed - NB not number pad *
           Local vScroll??, hScroll??, wScrollNotify??
            Select Case Asc(Right$(k$,1))
              Case 72 : vScroll = 1 : hScroll = 0 : wScrollNotify = %SB_LineUp    ' Up Arrow
              Case 80 : vScroll = 1 : hScroll = 0 : wScrollNotify = %SB_LineDown  ' Down arrow
              Case 73 : vScroll = 1 : hScroll = 0 : wScrollNotify = %SB_PageUp    ' Page up        *
              Case 81 : vScroll = 1 : hScroll = 0 : wScrollNotify = %SB_PageDown  ' Page down      *
              Case 77 : hScroll = 1 : vScroll = 0 : wScrollNotify = %SB_lineright ' Right arrow
              Case 75 : hScroll = 1 : vScroll = 0 : wScrollNotify = %SB_LineLeft  ' Left arrow
              Case 71 : hScroll = 1 : vScroll = 0 : wScrollNotify = %SB_Left      ' Home           *
              Case 79 : hScroll = 1 : vScroll = 0 : wScrollNotify = %SB_Right     ' End            *
            End Select
            If vScroll Then SendMessage(hGWin, %WM_VScroll, Mak(Long, wScrollNotify, 0), 0)
            If hScroll Then SendMessage(hGWin, %WM_HScroll, Mak(Long, wScrollNotify, 0), 0)
        End Select
      Wend
     
      RemoveProp hGWin, "OldGWroc"
      Graphic Attach hBmp, 0
      Graphic Bitmap End
    End Function
    '------------------/PBMain
    (PS Also a former Seismic Observer / doodle-bugger )
    Last edited by Dave Biggs; 31 Mar 2009, 10:29 AM. Reason: Added RemoveProp hGWin, "OldGWroc"
    Rgds, Dave
Working...
X