Announcement

Collapse
No announcement yet.

Vertically scroll child dialog inside of parent

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

  • Fred Harris
    replied
    Horizontal Scrolling Simple Grid Code

    Found some code from a long time ago where I was working with creating horizontal scrolling in a grid. The technique for verticle scrolling is exactly similiar though. The program also opens a log debug file. This runs as is...

    Code:
    'Shows how to make container on form for a grid or something.  Container is child of main window.
    #Compile  Exe
    #Include  "Win32api.inc"
    %ID_GRID           =1000
    %ID_PANE           =1002
    %ID_SCROLL_BAR     =1004
    Global fp As Long
    
    Type WndEventArgs
      wParam As Long
      lParam As Long
      hWnd   As Dword
      hInst  As Dword
    End Type
    
    Function fnCellProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
      If wMsg=%WM_PAINT Then
         Dim ps As PAINTSTRUCT
         Dim strLoc As String
         Dim hDC As Long
         hDC=BeginPaint(hWnd,ps)
         strLoc="("+    Trim$(Str$(    GetWindowLong(hWnd,0)   ))       +  ","  +    Trim$(Str$(GetWindowLong(hWnd,4)))         +")"
         Call TextOut(hDC,10,5,ByVal StrPtr(strLoc),Len(strLoc))
         Call EndPaint(hWnd,ps)
      End If
    
      fnCellProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
    End Function
    
    Function fnPaneProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
      fnPaneProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
    End Function
    
    Function fnGridProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
      Local hPane,hScroll As Dword
      Static xPos As Long
    
      Select Case As Long wMsg
        Case %WM_CREATE
          xPos=0
          fnGridProc=0
        Case %WM_HSCROLL
          'Print #fp, "Received WM_HSCROLL Message!"
          Select Case As Long LoWrd(wParam)
            Case %SB_LINELEFT
              If xPos<0 Then
                 Print #fp, "Received SB_LINELEFT Message!"
                 xPos=xPos+50
                 hPane=GetWindowLong(hWnd,0)
                 hScroll=GetWindowLong(hWnd,4)
                 Call MoveWindow(hPane,xPos,0,1000,250,%TRUE)
                 Call SetScrollPos(hScroll,%SB_CTL,Abs(xPos),%TRUE)
              End If
            Case %SB_LINERIGHT
              If xPos>375-1000 Then
                 Print #fp, "Received SB_LINERIGHT Message!"
                 xPos=xPos-50
                 hPane=GetWindowLong(hWnd,0)
                 hScroll=GetWindowLong(hWnd,4)
                 Call MoveWindow(hPane,xPos,0,1000,250,%TRUE)
                 Call SetScrollPos(hScroll,%SB_CTL,Abs(xPos),%TRUE)
              End If
          End Select
          fnGridProc=0
      End Select
    
      fnGridProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
    End Function
    
    Sub GridSetup(Wea As WndEventArgs)
      Local szGrid As Asciiz*8,szCell As Asciiz*8,szPane As Asciiz*8
      Local wType,xType,hHeap,hScroll,iMaxGrid,iMaxPane As Dword
      Local hGrid,hPane,hCell As Dword
      Local winclass As WndClassEx
      Local iRows,iCols As Long
      Local hMem As Dword Ptr
      Local strLoc As String
      Register i As Long
      Register j As Long
      Local hDC As Long
      Local k,m As Long
    
      'Create Grid Class
      iMaxGrid=375
      szGrid="Grid"                                         :   wType=%WS_CHILD Or %WS_VISIBLE
      xType=%WS_EX_OVERLAPPEDWINDOW                         :   winclass.hInstance=Wea.hInst
      winclass.lpszClassName=VarPtr(szGrid)                 :   winclass.lpfnWndProc=CodePtr(fnGridProc)
      winclass.style=%CS_DBLCLKS                            :   winclass.cbSize=SizeOf(WNDCLASSEX)
      winclass.hIcon=0                                      :   winclass.hIconSm=0
      winclass.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)   :   winclass.lpszMenuName=%NULL
      winclass.cbClsExtra=0                                 :   winclass.cbWndExtra=8
      winclass.hbrBackground=GetStockObject(%GRAY_BRUSH)
      Call RegisterClassEx(winclass)
      hGrid=CreateWindowEx(xType,szGrid,"",wType,20,20,iMaxGrid,275,Wea.hWnd,%ID_GRID,Wea.hInst,ByVal 0)
    
      'Create Pane                                          'Store hPane in bytes 0  -  3 in Grid
      szPane="Pane"
      iMaxPane=1000
      xType=0
      winclass.cbSize=SizeOf(WNDCLASSEX)
      winclass.style=%CS_HREDRAW Or %CS_VREDRAW
      winclass.lpfnWndProc=CodePtr(fnPaneProc)
      winclass.cbClsExtra=0
      winclass.cbWndExtra=0
      winclass.hInstance=Wea.hInst
      winclass.hIcon=0
      winclass.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)
      winclass.hbrBackground=GetStockObject(%WHITE_BRUSH)
      winclass.lpszMenuName=%NULL
      winclass.lpszClassName=VarPtr(szPane)
      winclass.hIconSm=0
      Call RegisterClassEx(winclass)
      hPane=CreateWindowEx(xType,szPane,"",wType,0,0,iMaxPane,250,hGrid,%ID_PANE,Wea.hInst,ByVal 0)
      Call SetWindowLong(hGrid,0,hPane)
    
      'Make Scrollbar                                      'Store hScroll in Bytes 4  -  7 in Grid
      hScroll=CreateWindow("scrollbar","",%SBS_HORZ Or %WS_VISIBLE Or %WS_CHILD,0,251,370,20,hGrid,%ID_SCROLL_BAR,Wea.hInst,ByVal 0)
      Print #fp,"hScroll="hScroll
      Call SetWindowLong(hGrid,4,hScroll)
      Call ShowWindow(hScroll,%SW_SHOW)
      Call SetScrollRange(hScroll,%SB_CTL,0,625,%TRUE)
    
      'Create Cells                                        '0  -  3     'Row
      szCell="Cell"                                        '4  -  7     'Col
      xType=0                                              '8  -  11    'hWnd
      winclass.cbSize=SizeOf(WNDCLASSEX)
      winclass.style=%CS_HREDRAW Or %CS_VREDRAW
      winclass.lpfnWndProc=CodePtr(fnCellProc)
      winclass.cbClsExtra=0
      winclass.cbWndExtra=12
      winclass.hInstance=Wea.hInst
      winclass.hIcon=0
      winclass.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)
      winclass.hbrBackground=GetStockObject(%WHITE_BRUSH)
      winclass.lpszMenuName=%NULL
      winclass.lpszClassName=VarPtr(szCell)
      winclass.hIconSm=0
      Call RegisterClassEx(winclass)
    
      iRows=10:iCols=20
      hHeap=GetProcessHeap()
      Print #fp, "hHeap="hHeap
      hMem=HeapAlloc(hHeap,%HEAP_ZERO_MEMORY,(iRows*iCols+1)*4)
      Print #fp,"hMem="hMem
      Call SetWindowLong(Wea.hWnd,8,hMem)
      '(i-1)*iCols+j
      k=1200
      For i=1 To iRows
        For j=1 To iCols
          hCell=CreateWindowEx(xType,szCell,"",%WS_CHILD Or %WS_VISIBLE Or %WS_BORDER,(j-1)*50,(i-1)*25,50,25,hPane,k,Wea.hInst,ByVal 0)
          Call SetWindowLong(hCell,0,i)
          Call SetWindowLong(hCell,4,j)
          Call SetWindowLong(hCell,8,k)
          Incr k
        Next j
      Next i
    
    End Sub
    
    Sub OnCreate(Wea As WndEventArgs)
      fp=FreeFile
      Open "Output.txt" For Output As #fp
      Call GridSetup(Wea)
    End Sub
    
    Sub OnPaint(Wea As WndEventArgs)
      Local lpPaint As PAINTSTRUCT
      Local hDC As Long
    
      hDC=BeginPaint(Wea.hWnd,lpPaint)
      Call EndPaint(Wea.hWnd,lpPaint)
    End Sub
    
    Sub OnClose(Wea As WndEventArgs)
      Local hMem As Dword Ptr
      Local blnFree As Long
    
      hMem=GetWindowLong(Wea.hWnd,8)
      Print #fp,"hMem="hMem
      blnFree=HeapFree(GetProcessHeap(),0,hMem)
      Print #fp,"blnFree="blnFree
      Call PostQuitMessage(0)
      Close #fp
    End Sub
    
    Function WndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) Export As Long
      Local pCreateStruct As CREATESTRUCT Ptr
      Static Wea As WndEventArgs
    
      Select Case wMsg
        Case %WM_CREATE
          pCreateStruct=lParam
          [email protected]
          Wea.hWnd=hWnd
          Call OnCreate(Wea)
          WndProc=0
          Exit Function
        Case %WM_PAINT
          Wea.hWnd=hWnd
          Call OnPaint(Wea)
          WndProc=0
          Exit Function
        Case %WM_CLOSE
          Call OnClose(Wea)
          WndProc=0
          Exit Function
      End Select
    
      WndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
    End Function
    
    Function WinMain(ByVal hIns As Long, ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr, ByVal iShow As Long) As Long
      Local winclass As WndClassEx
      Local szAppName As Asciiz*12
      Local hMainWnd As Dword
      Local Msg As tagMsg
    
      szAppName="Form3"
      winclass.cbSize=SizeOf(winclass)
      winclass.style=%CS_HREDRAW Or %CS_VREDRAW
      winclass.lpfnWndProc=CodePtr(WndProc)
      winclass.cbClsExtra=0
      winclass.cbWndExtra=16
      winclass.hInstance=hIns
      winclass.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
      winclass.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
      winclass.hbrBackground=%COLOR_BTNFACE+1
      winclass.lpszMenuName=%NULL
      winclass.lpszClassName=VarPtr(szAppName)
      winclass.hIconSm=LoadIcon(hIns,ByVal %IDI_APPLICATION)
      Call RegisterClassEx(winclass)
      hMainWnd=CreateWindow(szAppName,"Main Window",%WS_OVERLAPPEDWINDOW,200,100,425,360,0,0,hIns,ByVal 0)
      Call ShowWindow(hMainWnd,iShow)
      While GetMessage(Msg,%NULL,0,0)
        TranslateMessage Msg
        DispatchMessage Msg
      Wend
    
      Function=msg.wParam
    End Function

    Leave a comment:


  • Fred Harris
    replied
    Scrolling

    John,

    That was going to be my next Win32 Api tutorial. So far I have two on scrolling, and that was going to be my last scrolling demo. Essentially, In a CreateWindowEx() function call, the fourth and fifth parameters, i.e., horizontal position of window, and verticle position of window, are parameters of type int in C or LONG in PowerBASIC, and hence may take on negative values. This is essentially the key to scrolling one window within another, i.e., its parent. Here is the declaration from C.

    Code:
    HWND CreateWindowEx
    (
      DWORD dwExStyle,      // extended window style
      LPCTSTR lpClassName,  // pointer to registered class name
      LPCTSTR lpWindowName, // pointer to window name
      DWORD dwStyle,        // window style
      int x,                // horizontal position of window
      int y,                // vertical position of window
      int nWidth,           // window width
      int nHeight,          // window height
      HWND hWndParent,      // handle to parent or owner window
      HMENU hMenu,          // handle to menu, or child-window identifier
      HINSTANCE hInstance,  // handle to application instance
      LPVOID lpParam        // pointer to window-creation data
    );
    This is a technique I frequently use in my Windows CE programming for small handheld devices which don't have much screen real estate.

    So all you need to do is create a main top level or parent window with either horizontal, veriicle, or both types of scroll bars. Next create a 'pane' window as a child of the parent. This window will have a size suitable to contain all the eventual childs. Then create child windows on the 'pane'. The parent of these windows will be the pane. Therefore, you'll have a whole ancestry scheme of grandfather, father, and child. If the verticle position of the 'pane' is set to, -50 say - then child windows at first not seen will come into view. I could probably come up with an example, but it would take me some time.

    Leave a comment:


  • Dave Biggs
    replied
    ScrollWindow - http://www.powerbasic.com/support/fo...ML/002520.html

    ScrollWindowEx - http://www.powerbasic.com/support/fo...ML/000880.html

    Leave a comment:


  • Edwin Knoppert
    replied
    ScrollWindow() API

    Leave a comment:


  • Michael Mattias
    replied
    Pager Common Control?

    Leave a comment:


  • Vertically scroll child dialog inside of parent

    I've got an application where I use a label control and display same-sized child windows within this control. I'm curious if anyone knows how to display larger child windows (larger vertically) and use a scrollbar to scroll the various portions into view.

    I remember...I think...seeing an example of doing this on here, but I can't remember where I bookmarked it.

    Thanks!

    -John
Working...
X