Announcement

Collapse
No announcement yet.

Simulate Call/Return, Goto with Containers

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

  • Simulate Call/Return, Goto with Containers

    I've used this metaphor in the past to provide quite a bit of flexibility in navigation in an app so wanted to port it to PowerBasic. The parts of the app are:



    Demo
    • CallDemo.bas - Just provides a window to house the container.
    • Sample.inc - Provides a sample of using the container. In practice one of these is implemented for each "window" or functionality the app needs.
    Implementation
    • Container.inc - Provides the call/return/goto metaphor as a child window. That allows it to be placed in any container (window, MDI child, splitter, etc). as well as allowing other global window decorations.
    • Stack.inc - Implements a simple DWord stack (Window handle stack)
    Following is a snippet of use in the app:
    Code:
    Case %SAMPLE_CALL_NEW:
      hContainer = GetWindowLong( hSample, %SAMPLE_CONTAINER )
      hNew = Sample_CreateWindow( 1 )
      Call CallPanel( hContainer, hNew )
    Case %SAMPLE_GOTO_NEW
      hContainer = GetWindowLong( hSample, %SAMPLE_CONTAINER )
      hNew = Sample_CreateWindow( 1 )
      Call GotoPanel( hContainer, hNew )
    Case %SAMPLE_RETURN, %IdCancel
      hContainer = GetWindowLong( hSample, %SAMPLE_CONTAINER )
      Call ReturnPanel( hContainer )
    Essentially you just create a new window and decide if you want to call it or goto it. I typically use call in "drill-in" scenarios and goto's in "wizard" type scenarios.

    Edit: Fixed a small bug with the keyboard that prevented the escape key from going backward. Also added initial focus logic.
    Edit: "Refixed" the focus logic.

    CallDemo.bas
    Code:
    #Compile Exe "CallDemo.exe"
    #Dim All
    #Compiler PBWin 10
    #Register All
     
    #Resource VersionInfo
    #Resource FileVersion 1, 0, 0, 0
    #Resource ProductVersion 1, 0, 0, 0
    #Resource FileFlags 0
    #Resource StringInfo "0409", "04B0"
    #Resource Version$ "CompanyName",      "Larry Charlton"
    #Resource Version$ "FileDescription",  "Call Demo"
    #Resource Version$ "FileVersion",      "01.00.0000"
    #Resource Version$ "InternalName",     "CallDemo"
    #Resource Version$ "OriginalFilename", "CallDemo.exe"
    #Resource Version$ "LegalCopyright",   "Public Domain"
    #Resource Version$ "ProductName",      "CallDemo"
    #Resource Version$ "ProductVersion",   "01.00.0000"
    #Resource Version$ "Comments",         "Testing Call, Return, Goto for child panels"
    #Resource Manifest,     1, "theme.xml"
     
    #Include Once "win32api.inc"
    #Include Once "stack.inc"
    #Include Once "container.inc"
    #Include Once "sample.inc"
     
    $CALLDEMO_CLASS = "lcCallDemo"
     
    Global hRoot As Dword
     
    Function PBMain () As Long
      Local hCallDemo As Dword
     
      hCallDemo = CallDemo_CreateWindow()
      hRoot = hCallDemo
     
      ShowWindow( hCallDemo, %SW_ShowNormal )
      UpdateWindow( hCallDemo )
     
      Call EnumChildWindows( hCallDemo,  CodePtr( Container_InitialPaint ), 0 ): ' Ensure child controls painted
     
      Call CallDemo_Run( hCallDemo )
    End Function
     
    Function CallDemo_WndProc( ByVal hCallDemo As Dword, ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long) As Long
      Function = 0
      Select Case As Const wMsg
        Case %WM_Command
          If Hi(Word,wParam)=%BN_Clicked  Or Hi(Word,wParam) = 1 Then
            If Lo(Word,wParam) = %IdCancel Then
              Dim hChild As Dword
              hChild = GetWindow( hCallDemo, %GW_CHILD )
              SendMessage( hChild, wMsg, wParam, lParam )
            End If
          End If
        Case %WM_ERASEBKGND: Exit Function
        Case %WM_Destroy: PostQuitMessage( 0 ): Exit Function
        Case %WM_Size: CallDemo_OnSize( hCallDemo, wParam, lParam ): Exit Function
      End Select
      Function = DefWindowProc( hCallDemo, wMsg, wParam, lParam )
    End Function
     
    Sub CallDemo_OnSize( ByVal hCallDemo As Dword, ByVal wParam As Long, ByVal lParam As Long )
      Local hWnd As Dword
      Local h As Long, w As Long
      If wParam = %SIZE_RESTORED Then
        hWnd = GetWindow( hCallDemo, %GW_CHILD )
        w = Lo(Word, lParam )
        h = Hi(Word, lParam )
        MoveWindow( hWnd, 0, 0, w, h, 0 )
      End If
    End Sub
     
    Sub CallDemo_RegisterClasses()
      Dim wc As WNDCLASS
      Dim className As StringZ*20
      Static gInit As Long
     
      If gInit Then Exit Sub: ' Already initialized
      gInit=-1
     
      ' Register class for Overlapped window
      className = $CALLDEMO_CLASS
      wc.style = %CS_HREDRAW Or %CS_VREDRAW
      wc.lpfnWndProc = CodePtr( CallDemo_WndProc )
      wc.cbClsExtra = 0
      wc.cbWndExtra = 0: ' 4 - if allocating window data
      wc.hInstance = GetModuleHandle( ByVal 0 )
      wc.hIcon = LoadIcon( ByVal %NULL, ByVal %IDI_APPLICATION )
      wc.hCursor = LoadCursor(%NULL, ByVal %IDC_ARROW)
      wc.hbrBackground = %COLOR_WINDOW+1: ' %COLOR_3DFACE
      wc.lpszMenuName =  0
      wc.lpszClassName = VarPtr(className)
      If RegisterClass( wc )=0 Then
        MsgBox "RegisterClass for CallDemo failed"
        End
      End If
    End Sub
     
    Function CallDemo_CreateWindow() As Dword
      Local hCallDemo As Dword
      Local hContainer As Dword
      Local hNew As Dword
     
      Call CallDemo_RegisterClasses()
      hCallDemo = CreateWindowEx( 0, $CALLDEMO_CLASS, "Call Demo", %WS_OverlappedWindow Or %WS_ClipChildren, %CW_USEDEFAULT, %CW_USEDEFAULT, 500, 300, %NULL, %NULL, GetModuleHandle( ByVal 0 ), ByVal 0 )
      Function = hCallDemo
     
      hContainer = Container_CreateWindow(hCallDemo, 2):  ' Create container in parent window
     
      hNew = Sample_CreateWindow( 1 ):                    ' Create Sample window
      Call GotoPanel( hContainer, hNew ):                 ' Load in container
    End Function
     
    Function CallDemo_Run(ByVal hCallDemo As Long) As Long
      Local msg As tagMSG
      Local hActive As Dword
     
      Do While GetMessage( msg, %NULL, 0, 0 )
        hActive = GetActiveWindow()
        If IsWindow(hActive)=0 Or IsDialogMessage( hActive, msg ) = 0 Then
            TranslateMessage( msg )
            DispatchMessage( msg )
        End If
      Loop
    End Function
    Container.inc
    Code:
    $CONTAINER_CLASS = "lcContainer'
     
    %WM_RETURNING = (%WM_User+1): ' Return Panel occurred
    %WM_LEAVING = (%WM_User+2):  ' Leaving panel
    %WM_ARRIVING = (%WM_User+3): ' Call or Goto occurred
     
    Type ContainerData
      hCur As Dword: ' Current child
      stack As Variant Ptr
    End Type
     
    Function Container_WndProc( ByVal hContainer As Dword, ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long) As Long
      Function = 0
      Select Case As Const wMsg
        Case %WM_ERASEBKGND: Exit Function
        Case %WM_Size: Container_Size( hContainer, wParam, lParam )
        Case %WM_Destroy: Container_Destroy( hContainer )
        Case %WM_Command
          If Hi(Word,wParam)=%BN_Clicked  Or Hi(Word,wParam) = 1 Then
            If Lo(Word,wParam) = %IdCancel Then
              Dim hChild As Dword
              hChild = GetWindow( hContainer, %GW_CHILD )
              SendMessage( hChild, wMsg, wParam, lParam )
            End If
          End If
      End Select
      Function = DefWindowProc( hContainer, wMsg, wParam, lParam )
    End Function
     
    Sub Container_Destroy( ByVal hContainer As Dword )
      Local pContainer As ContainerData Ptr
      Local stack As iStack
      Local v As Variant
      pContainer = Container_GetData( hContainer )
      If pContainer Then
        If @pContainer.stack Then
          stack = Nothing
          v = stack
          @pContainer.@stack = v
          GlobalFree( @pContainer.stack )
        End If
        GlobalFree( pContainer )
      End If
      SetWindowLong( hContainer, 0, 0 )
    End Sub
     
    Sub Container_Size( ByVal hContainer As Dword, ByVal wParam As Long, ByVal lParam As Long)
      Local hWnd As Dword
      Local h As Long, w As Long
      If wParam = %SIZE_RESTORED Then
        hWnd = GetWindow( hContainer, %GW_CHILD )
        w = Lo(Word, lParam )
        h = Hi(Word, lParam )
        MoveWindow( hWnd, 0, 0, w, h, 0 )
      End If
    End Sub
     
    Sub Container_RegisterClasses()
      Dim wc As WNDCLASS
      Dim className As StringZ*20
      Static gInit As Long
     
      If gInit Then Exit Sub: ' Already initialized
      gInit=-1
     
      className = $CONTAINER_CLASS
      wc.style = 0
      wc.lpfnWndProc = CodePtr( Container_WndProc )
      wc.cbClsExtra = 0
      wc.cbWndExtra = 4: ' - if allocating window data
      wc.hInstance = GetModuleHandle( ByVal 0 )
      wc.hIcon = LoadIcon( ByVal %NULL, ByVal %IDI_APPLICATION )
      wc.hCursor = LoadCursor(%NULL, ByVal %IDC_ARROW)
      wc.hbrBackground = %COLOR_WINDOW+1: ' %COLOR_3DFACE
      wc.lpszMenuName =  0
      wc.lpszClassName = VarPtr(className)
      If RegisterClass( wc )=0 Then
        MsgBox "RegisterClass for Container failed"
        End
      End If
    End Sub
     
    Function Container_CreateWindow( ByVal hParent As Dword, ByVal controlId As Long ) Common As Dword
      Local hContainer As Dword
      Local pContainer As ContainerData Ptr
      Local stack As iStack
     
      Call Container_RegisterClasses()
      hContainer = CreateWindowEx( %WS_Ex_ControlParent, $CONTAINER_CLASS, "", %WS_Child Or %WS_ClipChildren Or %WS_Visible, 0, 0, 5, 5, hParent, controlId, GetModuleHandle( ByVal 0 ), ByVal 0 )
      Function = hContainer
      pContainer = GLobalAlloc( %GPTR, SizeOf(ContainerData) )
      @pContainer.stack = GlobalAlloc( %GPTR, 16 )
      stack = Class "cStack"
      @pContainer.@stack = stack
      SetWindowLong( hContainer, 0, pContainer )
    End Function
     
    Function Container_GetData( ByVal hContainer As Dword ) Common As Dword
      Function = GetWindowLong( hContainer, 0 )
    End Function
     
    Sub CallPanel( ByVal hContainer As Dword, ByVal hPanel As Dword ) Common
      Local pContainer As ContainerData Ptr
      Local stack As iStack
      Local v As Variant
     
      pContainer = Container_GetData( hContainer )
      If PanelStack( hContainer, v ) And @pContainer.hCur Then
        stack = v
        stack.Push( @pContainer.hCur )
      End If
      Call GotoPanel( hContainer, hPanel )
    End Sub
     
    Sub GotoPanel( ByVal hContainer As Dword, ByVal hPanel As Dword, Optional ByVal returning As Long ) Common
      Local hCur As Dword
      Local pContainer As ContainerData Ptr
      Local rc As RECT
      Local hWnd As Dword
     
      pContainer = Container_GetData( hContainer )
     
      hWnd = @pContainer.hCur
      If IsWindow( hWnd ) Then
        SendMessage( hWnd, %WM_LEAVING, 0, hContainer )
        SetParent( hWnd, %HWND_MESSAGE )
      End If
     
      SetParent( hPanel, hContainer )
      @pContainer.hCur = hPanel
     
      GetClientRect( hContainer, rc )
      SetWindowPos( hPanel, %HWND_TOP, 0, 0, rc.Right, rc.Bottom, %SWP_SHOWWINDOW )
      If returning Then
        SendMessage( hPanel, %WM_RETURNING, 0, hContainer )
      Else
        SendMessage( hPanel, %WM_ARRIVING, 0, hContainer )
      End If
     
      Call EnumChildWindows( hContainer,  CodePtr( Container_InitialPaint ), 0 ): ' Ensure child controls painted
     
      hWnd = GetAncestor( hContainer, %GA_ROOT )
      SetFocus( GetNextDlgTabItem( hWnd, hPanel, 0 ) )
    End Sub
     
    Sub ReturnPanel( ByVal hContainer As Dword ) Common
      Local stack As iStack
      Local v As Variant
      If PanelStack( hContainer, v ) Then
        stack = v
        If stack.Count Then
          Call GotoPanel( hContainer, stack.Pop(), -1 )
        End If
      End If
    End Sub
     
    Function CurrentPanel( ByVal hContainer As Dword ) Common As Dword
      Local pContainer As ContainerData Ptr
      pContainer = Container_GetData( hContainer )
      Function = @pContainer.hCur
    End Function
     
    Function PanelCount( ByVal hContainer As Dword ) Common As Long
      Local stack As iStack
      Local v As Variant
      If PanelStack( hContainer, v ) Then
        stack = v
        Function = stack.Count
      End If
    End Function
     
    Function PanelStack( ByVal hContainer As Dword, ByRef v As Variant ) As Long
      Local pContainer As ContainerData Ptr
      Local stack As iStack
      Local pV As Variant Ptr
      pContainer = Container_GetData( hContainer )
      pV = @pContainer.stack: ' Not sure why I couldn't do the following: v = @pContainer.@stack
      If pV Then
        stack = @pV
        v = stack
        Function = IsObject( stack )
      End If
    End Function
     
    Function Container_InitialPaint( ByVal hWnd As Dword, ByVal lParam As Long ) As Long
      RedrawWindow( hWnd, ByVal %NULL, ByVal %NULL, %RDW_FRAME Or %RDW_INVALIDATE )
      Function = %TRUE
    End Function
    Sample.inc
    Code:
    $SAMPLE_CLASS = "lcSample'
     
    Global sample_cnt As Long
     
    %SAMPLE_CALL_NEW = 101
    %SAMPLE_GOTO_NEW = 102
    %SAMPLE_RETURN   = 103
     
    %SAMPLE_NUM = 0
    %SAMPLE_CONTAINER = 4
    %SAMPLE_COLOR = 8
     
    Function Sample_WndProc( ByVal hSample As Dword, ByVal wMsg As Dword, ByVal wParam As Long, ByVal lParam As Long) Common As Long
      Local hContainer As Dword
      Local hNew As Dword
      Local hChild As Dword
      Function = 0
      Select Case As Const wMsg
        Case %WM_ARRIVING:
          SetWindowLong(hSample, %SAMPLE_CONTAINER, lParam)
          Exit Function
        Case %WM_Command
          If Hi(Word,wParam)=%BN_Clicked  Or Hi(Word,wParam) = 1 Then
            Select Case Lo(Word,wParam)
              Case %SAMPLE_CALL_NEW:
                hContainer = GetWindowLong( hSample, %SAMPLE_CONTAINER )
                hNew = Sample_CreateWindow( 1 )
                Call CallPanel( hContainer, hNew )
              Case %SAMPLE_GOTO_NEW
                hContainer = GetWindowLong( hSample, %SAMPLE_CONTAINER )
                hNew = Sample_CreateWindow( 1 )
                Call GotoPanel( hContainer, hNew )
              Case %SAMPLE_RETURN, %IdCancel
                hContainer = GetWindowLong( hSample, %SAMPLE_CONTAINER )
                Call ReturnPanel( hContainer )
            End Select
            Exit Function
          End If
        Case %WM_Paint: Call Sample_OnPaint( hSample )
      End Select
      Function = DefWindowProc( hSample, wMsg, wParam, lParam )
    End Function
     
    Sub Sample_OnPaint( ByVal hSample As Dword )
      Local v As Long
      Local rc As RECT
      Local br As Dword
      Local ps As PAINTSTRUCT
      Local hdc As Dword
      Local msg As String
      Local hContainer As Dword
     
      v = GetWindowLong( hSample, %SAMPLE_NUM )
      hContainer = GetWindowLong( hSample, %SAMPLE_CONTAINER )
      GetClientRect( hSample, rc )
     
      hdc = BeginPaint( hSample, ps )
      br = CreateSolidBrush( GetWindowLong( hSample, %SAMPLE_COLOR ) )
      FillRect( hdc, rc, br )
      DeleteObject( br )
      msg = "Sample " + Format$( v, "#,##0" ) + " Stack has " + Format$( PanelCount( hContainer ), "#,##0")
      DrawText( hdc, ByVal StrPtr(msg), Len(msg), rc, %DT_CENTER Or %DT_VCENTER Or %DT_SINGLELINE)
      EndPaint( hSample, ps )
    End Sub
     
    Sub Sample_RegisterClasses() Common
      Dim wc As WNDCLASS
      Dim className As StringZ*20
      Static gInit As Long
     
      If gInit Then Exit Sub: ' Already initialized
      gInit=-1
      sample_cnt = 0
     
      className = $SAMPLE_CLASS
      wc.style = 0
      wc.lpfnWndProc = CodePtr( Sample_WndProc )
      wc.cbClsExtra = 0
      wc.cbWndExtra = 12: 'if allocating window data
      wc.hInstance = GetModuleHandle( ByVal 0 )
      wc.hIcon = LoadIcon( ByVal %NULL, ByVal %IDI_APPLICATION )
      wc.hCursor = LoadCursor(%NULL, ByVal %IDC_ARROW)
      wc.hbrBackground = %COLOR_WINDOW+1: ' %COLOR_3DFACE
      wc.lpszMenuName =  0
      wc.lpszClassName = VarPtr(className)
      If RegisterClass( wc )=0 Then
        MsgBox "RegisterClass for Sample failed"
        End
      End If
    End Sub
     
    Function Sample_CreateWindow( ByVal controlId As Long ) Common As Dword
      Local hSample As Dword
      Local vStyle As Dword
      Local colors() As Dword
     
      ReDim colors(9)
     
      Array Assign colors() = &H8080F0, &HCBC0FF, &H7AA0FF, &HE0FFFF, &HD8BFD8, &H00FF7F, &HEEEEAF, &HE6E0B0, &HCDEBFF, &HD3D3D3
     
      Call Sample_RegisterClasses()
      hSample = CreateWindowEx( %WS_Ex_ControlParent, $SAMPLE_CLASS, "", %WS_Child Or %WS_ClipChildren Or %WS_Visible, 0, 0, 5, 5, %HWND_MESSAGE, controlId, GetModuleHandle( ByVal 0 ), ByVal 0 )
      Function = hSample
      Incr sample_cnt
      SetWindowLong( hSample, %SAMPLE_NUM, sample_cnt )
      SetWindowLong( hSample, %SAMPLE_CONTAINER, 0 ): ' Container
      SetWindowLong( hSample, %SAMPLE_COLOR, colors(sample_cnt Mod 10) )
     
      vStyle = %WS_Child Or %WS_Visible Or %WS_TabStop
      CreateWindowEx( 0, "BUTTON",       "&Call new", vStyle,  10,10,80,32, hSample, %SAMPLE_CALL_NEW, GetModuleHandle( ByVal 0 ), ByVal 0 )
      CreateWindowEx( 0, "BUTTON",       "&Goto new", vStyle, 100,10,80,32, hSample, %SAMPLE_GOTO_NEW, GetModuleHandle( ByVal 0 ), ByVal 0 )
      CreateWindowEx( 0, "BUTTON",       "&Return",   vStyle, 190,10,80,32, hSample, %SAMPLE_RETURN,   GetModuleHandle( ByVal 0 ), ByVal 0 )
    End Function
    Stack.inc
    Code:
    Class cStack Guid$("{66812288-483a-42d6-9b19-cd035d8c6010}") Common
      Instance count_ As Long
      Instance stack_() As Dword
      Instance size_ As Long
     
     
      Class Method Create()
        ReDim stack_(20)
        size_ = 20
      End Method
     
      Interface iStack Guid$("{e3ed37d4-e4fc-42d8-a4af-4d06e787e011}")
        Inherit IUnknown
     
        Property Get Count() As Long
          Property = count_
        End Property
     
        Property Get Item( ByVal offset As Long ) As Dword
          If offset>0 And offset<count_ Then
            Property = stack_( offset )
          End If
        End Property
     
        Method Push( value As Dword )
          If count_ >= size_ Then
            size_+=20
            ReDim Preserve stack_(size_)
          End If
          stack_(count_) = value
          Incr count_
        End Method
     
        Method Pop() As Dword
          If count_ > 0 Then
            Decr count_
            Method = stack_( count_ )
          End If
        End Method
     
        Method Peek() As Dword
          If count_ > 0 Then
            Method = stack_( count_-1 )
          End If
        End Method
      End Interface
    End Class
    Last edited by Larry Charlton; 7 Aug 2011, 03:55 PM.
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream
Working...
X