Announcement

Collapse
No announcement yet.

Polymorphic shapes

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

  • Polymorphic shapes

    Here's a more complete DDT example of a polymorphic list of shapes. Adding new shapes is done by defining a new iShape and then registering it in the master list.
    Zip

    PolymorphicShapes.bas
    Code:
    #Compile Exe
    #Compiler PBWin 10
    #Dim All
     
    ' Demonstrates using interfaces to create a polymorphic list of shapes.
    ' Allows for creating new shapes
    ' Allows clearing the current set of shapes
    ' Saving the current set of shapes to disk
    ' Loading a set of shapes from disk
    ' Editing the properties of a shape (Click on a shape to edit it)
    '
    ' In PBMain, see the section on Registering shapes
    ' Uncomment the triangle line to include handling triangles
    '
    ' The basic process to add a new shape is:
    ' 1) Create a class that implement iShape
    ' 2) Register an instance of the class in the master list
     
    ' If you save a file with several shapes including triangles
    ' and then comment out the registration of one of the shapes and run again
    ' you can still load the file but you only see the registered shapes.  If you
    ' save it, you will loose the unregistered shapes.
     
     
    #Include "windows.inc"
    'Interface iShape
    '  Inherit IUnknown
    '  Property Get Type() As String - Returns the name of the type
    '  Property Get Settings() As String - Returns the values for the shape as a string
    '  Property Set Settings( value As String ) - Sets the values for the shape from a string
    '  Method Draw( Optional ByRef clr As Dword ) - Draws the shape on the currently attached graphic control
    '  Method Edit() - Edits the shapes values
    '  Method New( ByRef obj As iShape ) - Factory method to create a new instance
    '  Method Hit( ByVal x As Long, ByVal y As Long ) As Long - Test if the shape was hit by the x,y
    'End Interface
     
    'Function GetShape( hDlg As Dword ) As Long - Gets the index of a shape from drawList
    'Sub ClearItems() - Clears draw list
    'Sub AddItem( value As iShape ) - Adds a shape to drawList
    'Sub RedrawItems() - Redraws drawList
    'Sub DrawItems( hDlg As Dword, controlId As Long, drawList As ILinkListCollection ) - Draw an item on a target
    'Sub FlashItem( hDlg As Dword, controlId As Long, shape As iShape ) - Draw an emphasised item (for Editing)
     
    Global drawList As ILinkListCollection: ' List of shapes to draw
    Global masterList As ILinkListCollection: ' Master list of possible shapes (Used to generate buttons and create new shapes)
    Global gWin As Dword: ' Graphic window we're drawing on
    Global hContainer As Dword: ' Container for editing shapes properties
    Global viewManager As iViewManager: ' View manager for editing shape properties
     
    %buttonWidth = 100
    %gControl = 101
     
    Function PBMain () As Long
      Local shape As iShape
      Local v As Variant
      Local value As String
      Local i As Long
      Local c As Long
      Local x, y As Long
     
      Randomize
     
      drawList = Class "LinkListCollection"
      masterList = Class "LinkListCollection"
     
      '=============================================
      ' Register shapes
      ' To add a new shape, create a class that implements iShape
      ' Add to this list
      shape = Class "cCircle":    masterList.Add( shape )
      shape = Class "cRectangle": masterList.Add( shape )
      ' Uncomment the next line to add triangle processing
      'shape = Class "cTriangle": masterList.Add( shape )
      '=============================================
     
      '=============================================
      ' Create Dialog
      Dialog New Pixels, 0, "Polymorphic Drawing Example", 10, 110, 10 + 320 + 10 + %buttonWidth + 10 + 100 + 10, 320, _
        %WS_Border Or %WS_DlgFrame Or %WS_Caption Or %WS_SysMenu Or %WS_MinimizeBox To gWin
      Control Add Graphic, gWin, %gControl, "", 0, 0, 320, 320, %WS_Border Or %SS_Notify, Call GraphicProc
      Graphic Attach gWin, %gControl
      Graphic Clear RGB(255,255,255), 0: ' Solid clear
      Graphic Detach
     
      ' Add a button for each shape we have
      x = 320+20
      y = 10
      c = masterList.Count
      For i=1 To c
        v = masterList.Item(i)
        shape = v
        value = shape.Type()
        Control Add Button, gWin, 100+i, value, x, y, %buttonWidth, 30, Call CmdClick
        y += 30+4
      Next
     
      ' Add some additional buttons
      Control Add Button, gWin, 100+c+1, "Clear", x, y, %buttonWidth, 30, Call CmdClear: y += 30+4
      Control Add Button, gWin, 100+c+2, "Save", x, y, %buttonWidth, 30, Call CmdSaveItems: y += 30+4
      Control Add Button, gWin, 100+c+3, "Load", x, y, %buttonWidth, 30, Call CmdLoadItems: y += 30+4
     
      x += %buttonWidth + 10
      Dialog New Pixels, gWin, "", x, 10, 100, 300, %WS_Child Or %WS_Visible Or %WS_Border To hContainer
      Call NewViewManager( viewManager, hContainer )
      viewManager.AllowCloseAll = -1
      Dialog Show Modeless hContainer
     
      Dialog Show Modal gWin
      '=============================================
    End Function
     
    '===============================================================
    ' Call backs
    '===============================================================
    CallBack Function CmdSaveItems
      Local fileName As String
      Local sb As IStringBuilderA
      Local i, c As Long
      Local v As Variant
      Local shape As iShape
      sb = Class "StringBuilderA"
     
      fileName = InputBox$( "Filename?" )
      If fileName<>"" Then
        If InStr(fileName, ".")=0 Then fileName += ".poly"
        c = drawList.Count
        For i=1 To c
          v = drawList.Item(i)
          shape = v
          sb.Add(shape.Settings)
          If i<c Then sb.Add( $CrLf )
        Next
        Open fileName For Output As #1
        Print #1, sb.String;
        Close #1
      End If
    End Function
     
    CallBack Function CmdLoadItems
      Local filename As String
      Local v As Variant
      Local shape As iShape
      Local newShape As iShape
      Local buf As String
      Local shapeName As String
      Local j, p, i, c As Long
      Local l() As String
     
      viewManager.CloseView()
      Display Openfile , , , "Open file", Exe.Path$, "Poly" + Chr$(0) + "*.poly" + Chr$(0), "", ".poly", %OFN_FileMustExist To filename
      If filename<>"" Then
        drawList.Clear()
        Open filename For Binary As #1
        Get$ #1, Lof(1), buf
        Close #1
        c = ParseCount( buf, $CrLf )
        ReDim l(c-1)
        Parse buf, l(), $CrLf
        For i=0 To c-1
          p = InStr(l(i), ",")
          If p>0 Then
            shapeName = Left$(l(i), p-1 )
            For j=1 To masterList.Count
              v = masterList.Item(j)
              shape = v
              If LCase$(shapeName) = shape.Type Then
                shape.New( newShape )
                newShape.Settings = l(i)
                drawList.Add( newShape )
                Exit For
              End If
            Next
          End If
        Next
      End If
      Call RedrawItems()
    End Function
     
    CallBack Function CmdClear
      Call ClearItems()
    End Function
     
    CallBack Function CmdClick
      Local cmd As Long
      Local v As Variant
      Local shape As iShape
      Local newShape As iShape
      cmd = Cb.Ctl - 100
      If cmd<1 Or cmd>masterList.Count Then
        MsgBox "Invalid button!"
        Exit Function
      End If
      v = masterList.Item(cmd)
      shape = v
      shape.New( newShape )
      Call AddItem( newShape )
    End Function
     
    CallBack Function GraphicProc
      Local hDlg As Dword
      Local v As Variant
      Local shape As iShape
      Local i, clicked As Long
      Local x, y As Single
      Local pnt As Point
      hDlg = Cb.Hndl
      If Cb.Msg = %WM_Command And Cb.CtlMsg = %STN_CLICKED Then
        GetCursorPos( pnt )
        ScreenToClient(hDlg, pnt)
        x = pnt.x
        y = pnt.y
        For i=1 To drawList.Count
          v = drawList.Item(i)
          shape = v
          If IsInterface( shape, iShape ) Then
            If shape.Hit(x,y) Then
              Call RedrawItems()
              Call FlashItem( hDlg, %gControl, shape )
              shape.Edit()
              Exit Function
            End If
          End If
        Next
      End If
    End Function
     
    '===============================================================
    ' Generic shape routines
    '===============================================================
    Function GetShape( hDlg As Dword ) As Long
      Dim e As Dword
      Local v As Variant
      Local shape As iShape
      Local circle As iCircle
      Local i As Long
      Dialog Get User hDlg, 0 To e
      For i = 1 To drawList.Count
        v = drawList.Item(i)
        shape = v
        If IsInterface( shape, iShape ) Then
          If ObjPtr(shape) = e Then
            Function = i
            Exit Function
          End If
        End If
      Next
    End Function
     
    Sub ClearItems()
      drawList.Clear()
      Call RedrawItems()
    End Sub
     
    Sub AddItem( value As iShape )
      drawList.Add( value )
      Call RedrawItems()
    End Sub
     
    Sub RedrawItems()
      Call DrawItems( gWin, %gControl, drawList )
    End Sub
     
    Sub DrawItems( hDlg As Dword, controlId As Long, drawList As ILinkListCollection )
      ' hDlg = Window we're drawing on
      ' controlId = Graphic control we're drawing on
      ' drawList = iLinkListCollection of iShape's to draw
      Local cnt As Long
      Local i As Long
      Local v As Variant
      Local shape As iShape
      Graphic Attach hDlg, controlId, ReDraw
      Graphic Clear RGB(255,255,255), 0: ' Solid clear
      Graphic Width 2
      cnt = drawList.Count
      For i=1 To cnt
        v = drawList.Item(i)
        shape = v
        If IsInterface( shape, iShape ) = -1 Then
          shape.Draw()
        End If
      Next
      Graphic ReDraw
      Graphic Detach
    End Sub
     
    Sub FlashItem( hDlg As Dword, controlId As Long, shape As iShape )
      Graphic Attach hDlg, controlId
      Graphic Width 4
      shape.Draw( RGB(255,128,0) )
      Graphic Detach
    End Sub
     
    '===============================================================
    ' Circle
    '===============================================================
    Class cCircle
      Instance x_ As Long
      Instance y_ As Long
      Instance radius_ As Long
      Instance hDlg As Dword
     
      Class Method Create()
        radius_ = Rnd(4,40)
        x_ = Rnd(1+radius_,320-radius_)
        y_ = Rnd(1+radius_,320-radius_)
      End Method
      Class Method Destroy()
        If hDlg>0 Then
          Dialog End hDlg
          hDlg = 0
        End If
      End Method
      Interface iShape
        Inherit IUnknown
     
        Property Get Type() As String
          Property = "circle"
        End Property
     
        Property Get Settings() As String
          Local sb As IStringBuilderA
          Local v As String
          sb = Class "StringBuilderA"
          sb.Add("circle,")
          v = Format$( x_, "0")
          sb.Add( v )
          sb.Add(",")
          v = Format$( y_, "0")
          sb.Add( v )
          sb.Add(",")
          v = Format$( radius_, "0")
          sb.Add( v )
          Property = sb.String
        End Property
     
        Property Set Settings( value As String )
          Local values() As String
          Local vc As Long
          vc = ParseCount( value, "," )
          ReDim values(vc-1)
          Parse value, values(), ","
          If LCase$( values(0) )<>"circle" Then
            MsgBox "Invalid setting, s/b circle"
            Exit Property
          End If
          If vc<>4 Then
            MsgBox "Invalid circle settings s/b circle,x,y,radius"
            Exit Property
          End If
          x_ = Val( values(1) )
          y_ = Val( values(2) )
          radius_ = Val( values(3) )
        End Property
     
        Method Draw( Optional ByRef clr As Dword )
          Local clr_ As Dword
          If IsMissing( clr ) Then
            clr_ = RGB(0,0,0)
          Else
            clr_ = clr
          End If
          Graphic Ellipse (x_-radius_, y_-radius_) - (x_+radius_, y_+radius_), clr_
        End Method
     
        Method Edit()
          Local a As Dword
          Local y, c, index As Long
          Local v As String
     
          If hDlg=0 Then
            a = ObjPtr(Me)
            Dialog New Pixels, viewManager.Container, "Edit Circle", 0, 0, 100, 300, %WS_Child Or %WS_Visible To hDlg
            Dialog Set User hDlg, 0, a
     
            y = 10
            c = 1
            v = Format$( x_, "0" )
            Control Add Label, hDlg, 500+c, "X", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll: y+=33
            c+=1
            v = Format$( y_, "0" )
            Control Add Label, hDlg, 500+c, "Y", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll: y+=33
            c+=1
     
            v = Format$( radius_, "0" )
            Control Add Label, hDlg, 500+c, "Radius", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll: y+=33
            c+=1
            Control Add Button, hDlg, 801, "Update", 10, y, 80, 30, %BS_Center Or %BS_VCenter Or %WS_TabStop Or %SS_Notify, Call CmdCircleUpdate: y+=33
            Control Add Button, hDlg, 802, "Cancel", 10, y, 80, 30, %BS_Center Or %BS_VCenter Or %WS_TabStop Or %SS_Notify, Call CmdCircleCancel
            Dialog Show Modeless hDlg
          Else
            v = Format$( x_, "0" ):       Control Set Text hDlg, 101, v
            v = Format$( y_, "0" ):       Control Set Text hDlg, 102, v
            v = Format$( radius_, "0" ):  Control Set Text hDlg, 103, v
          End If
          viewManager.GotoView( hDlg )
        End Method
     
        Method New( ByRef obj As iShape )
          obj = Class "cCircle"
        End Method
     
        Method Hit( ByVal x As Long, ByVal y As Long ) As Long
          If Sqr( (x-x_)*(x-x_) + (y-y_)*(y-y_) ) <= radius_ Then
            Method = -1
          Else
            Method = 0
          End If
        End Method
      End Interface
      Interface iCircle
        Inherit IUnknown
     
        Property Get X() As Long
          Property = x_
        End Property
     
        Property Set X( value As Long )
          x_ = value
        End Property
     
        Property Get Y() As Long
          Property = y_
        End Property
     
        Property Set Y( value As Long )
          y_ = value
        End Property
     
        Property Get Radius() As Long
          Property = radius_
        End Property
     
        Property Set Radius( value As Long )
          radius_ = value
        End Property
      End Interface
    End Class
     
    CallBack Function CmdCircleUpdate
      Local index As Long
      Local v As Variant
      Local shape As iShape
      Local circle As iCircle
      Local value As String
     
      index = GetShape( Cb.Hndl )
      If index=0 Then Exit Function
     
      v = drawList.Item(index)
      shape = v
      circle = shape
      If IsInterface( circle, iCircle ) Then
        Control Get Text Cb.Hndl, 101 To value
        circle.X = Val(value)
     
        Control Get Text Cb.Hndl, 102 To value
        circle.Y = Val(value)
     
        Control Get Text Cb.Hndl, 103 To value
        circle.Radius = Val(value)
     
        viewManager.CloseView()
        Call RedrawItems()
        Exit Function
      End If
    End Function
     
    CallBack Function CmdCircleCancel
      viewManager.CloseView()
      Call RedrawItems()
    End Function
     
    '===============================================================
    ' Rectangle
    '===============================================================
    Class cRectangle
      Instance x_ As Long
      Instance y_ As Long
      Instance width_ As Long
      Instance height_ As Long
      Instance hDlg As Dword
     
      Class Method Create()
        width_ = Rnd(8,80)
        height_ = Rnd(8,80)
        x_ = Rnd(1,320-width_)
        y_ = Rnd(1,320-height_)
      End Method
      Class Method Destroy()
        If hDlg>0 Then
          Dialog End hDlg
          hDlg = 0
        End If
      End Method
      Interface iShape
        Inherit IUnknown
     
        Property Get Type() As String
          Property = "rectangle"
        End Property
     
        Property Get Settings() As String
          Local sb As IStringBuilderA
          Local v As String
          sb = Class "StringBuilderA"
          sb.Add("rectangle,")
          v = Format$( x_, "0")
          sb.Add( v )
          sb.Add(",")
          v = Format$( y_, "0")
          sb.Add( v )
          sb.Add(",")
          v = Format$( width_, "0")
          sb.Add( v )
          sb.Add(",")
          v = Format$( height_, "0")
          sb.Add( v )
          Property = sb.String
        End Property
     
        Property Set Settings( value As String )
          Local values() As String
          Local vc As Long
          vc = ParseCount( value, "," )
          ReDim values(vc-1)
          Parse value, values(), ","
          If LCase$( values(0) )<>"rectangle" Then
            MsgBox "Invalid setting, s/b rectangle"
            Exit Property
          End If
          If vc<>5 Then
            MsgBox "Invalid rectangle settings s/b rectangle,x,y,width,height"
            Exit Property
          End If
          x_ = Val( values(1) )
          y_ = Val( values(2) )
          width_ = Val( values(3) )
          height_ = Val( values(4) )
        End Property
     
        Method Draw( Optional ByRef clr As Dword)
          Local clr_ As Dword
          If IsMissing( clr ) Then
            clr_ = RGB(0,0,0)
          Else
            clr_ = clr
          End If
     
          Graphic Line (x_, y_) - (x_+width_, y_), clr_
          Graphic Line -(x_+width_, y_+height_), clr_
          Graphic Line -(x_, y_+height_), clr_
          Graphic Line -(x_, y_-1), clr_
        End Method
     
        Method Edit()
          Local a As Dword
          Local y, c As Long
          Local v As String
     
          If hDlg=0 Then
            a = ObjPtr(Me)
            Dialog New Pixels, viewManager.Container, "Edit Rectangle", 0, 0, 100, 300, %WS_Child Or %WS_Visible To hDlg
            Dialog Set User hDlg, 0, a
     
            y = 10
            c = 1
     
            v = Format$( x_, "0" )
            Control Add Label, hDlg, 500+c, "X", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll
            y+=33
            c+=1
     
            v = Format$( y_, "0" )
            Control Add Label, hDlg, 500+c, "Y", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll
            y+=33
            c+=1
     
            v = Format$( width_, "0" )
            Control Add Label, hDlg, 500+c, "Width", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll
            y+=33
            c+=1
     
            v = Format$( height_, "0" )
            Control Add Label, hDlg, 500+c, "Height", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll
            y+=33
            c+=1
     
            Control Add Button, hDlg, 801, "Update", 10, y, 80, 30, %BS_Center Or %BS_VCenter Or %WS_TabStop Or %SS_Notify, Call CmdRectangleUpdate: y+=33
            Control Add Button, hDlg, 802, "Cancel", 10, y, 80, 30, %BS_Center Or %BS_VCenter Or %WS_TabStop Or %SS_Notify, Call CmdRectangleCancel
            Dialog Show Modeless hDlg
          Else
            v = Format$( x_, "0" ):       Control Set Text hDlg, 101, v
            v = Format$( y_, "0" ):       Control Set Text hDlg, 102, v
            v = Format$( width_, "0" ):   Control Set Text hDlg, 103, v
            v = Format$( height_, "0" ):  Control Set Text hDlg, 104, v
          End If
          viewManager.GotoView( hDlg )
        End Method
     
        Method New( ByRef obj As iShape )
          obj = Class "cRectangle"
        End Method
     
        Method Hit( ByVal x As Long, ByVal y As Long ) As Long
          If x>=x_ And y>=y_ And x<=x_+width_ And y<=y_+height_ Then
            Method = -1
          Else
            Method = 0
          End If
        End Method
      End Interface
      Interface iRectangle
        Inherit IUnknown
     
        Property Get X() As Long
          Property = x_
        End Property
     
        Property Set X( value As Long )
          x_ = value
        End Property
     
        Property Get Y() As Long
          Property = y_
        End Property
     
        Property Set Y( value As Long )
          y_ = value
        End Property
     
        Property Get Width() As Long
          Property = width_
        End Property
     
        Property Set Width( value As Long )
          width_ = value
        End Property
     
        Property Get Height() As Long
          Property = height_
        End Property
     
        Property Set Height( value As Long )
          height_ = value
        End Property
      End Interface
    End Class
     
    CallBack Function CmdRectangleUpdate
      Local index As Long
      Local v As Variant
      Local shape As iShape
      Local editRect As iRectangle
      Local value As String
     
      index = GetShape( Cb.Hndl )
      If index=0 Then Exit Function
     
      v = drawList.Item(index)
      shape = v
      editRect = shape
      If IsInterface( editRect, iRectangle ) Then
        Control Get Text Cb.Hndl, 101 To value: editRect.X = Val(value)
        Control Get Text Cb.Hndl, 102 To value: editRect.Y = Val(value)
        Control Get Text Cb.Hndl, 103 To value: editRect.Width = Val(value)
        Control Get Text Cb.Hndl, 104 To value: editRect.Height = Val(value)
        viewManager.CloseView()
        Call RedrawItems()
      End If
    End Function
     
    CallBack Function CmdRectangleCancel
      viewManager.CloseView()
      Call RedrawItems()
    End Function
     
    '===============================================================
    ' Triangle
    '===============================================================
    Class cTriangle
      Instance x_ As Long
      Instance y_ As Long
      Instance halfSide_ As Long
      Instance hDlg As Dword
     
      Class Method Create()
        halfSide_ = Rnd(4,40)
        x_ = Rnd(1+halfSide_,320-halfSide_)
        y_ = Rnd(1+halfSide_,320-halfSide_)
      End Method
      Class Method Destroy()
        If hDlg>0 Then
          Dialog End hDlg
          hDlg = 0
        End If
      End Method
      Interface iShape
        Inherit IUnknown
     
        Property Get Type() As String
          Property = "triangle"
        End Property
     
        Property Get Settings() As String
          Local sb As IStringBuilderA
          Local v As String
          sb = Class "StringBuilderA"
          sb.Add("triangle,")
          v = Format$( x_, "0")
          sb.Add( v )
          sb.Add(",")
          v = Format$( y_, "0")
          sb.Add( v )
          sb.Add(",")
          v = Format$( halfSide_, "0")
          sb.Add( v )
          Property = sb.String
        End Property
     
        Property Set Settings( value As String )
          Local values() As String
          Local vc As Long
          vc = ParseCount( value, "," )
          ReDim values(vc-1)
          Parse value, values(), ","
          If LCase$( values(0) )<>"triangle" Then
            MsgBox "Invalid setting, s/b triangle"
            Exit Property
          End If
          If vc<>4 Then
            MsgBox "Invalid triangle settings s/b triangle,x,y,radius"
            Exit Property
          End If
          x_ = Val( values(1) )
          y_ = Val( values(2) )
          halfSide_ = Val( values(3) )
        End Property
     
        Method Draw( Optional ByRef clr As Dword )
          Local clr_ As Dword
          If IsMissing( clr ) Then
            clr_ = RGB(0,0,0)
          Else
            clr_ = clr
          End If
     
          Graphic Line (x_-halfSide_, y_+halfSide_) - (x_+halfSide_, y_+halfSide_), clr_
          Graphic Line -(x_, y_-halfSide_), clr_
          Graphic Line -(x_-halfSide_, y_+halfSide_), clr_
        End Method
     
        Method Edit()
          Local a As Dword
          Local y, c As Long
          Local v As String
     
          If hDlg=0 Then
            a = ObjPtr(Me)
            Dialog New Pixels, viewManager.Container, "Edit Triangle", 0, 0, 100, 300, %WS_Child Or %WS_Visible To hDlg
            Dialog Set User hDlg, 0, a
     
            y = 10
            c = 1
            v = Format$( x_, "0" )
            Control Add Label, hDlg, 500+c, "X", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll
            y+=33
            c+=1
            v = Format$( y_, "0" )
            Control Add Label, hDlg, 500+c, "Y", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll
            y+=33
            c+=1
     
            v = Format$( halfSide_, "0" )
            Control Add Label, hDlg, 500+c, "Half side", 10, y, 80, 19: y+=20
            Control Add TextBox, hDlg, 100+c, v, 10, y, 80, 23, %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll
            y+=33
            c+=1
            Control Add Button, hDlg, 801, "Update", 10, y, 80, 30, %BS_Center Or %BS_VCenter Or %WS_TabStop Or %SS_Notify, Call CmdTriangleUpdate: y+=33
            Control Add Button, hDlg, 802, "Cancel", 10, y, 80, 30, %BS_Center Or %BS_VCenter Or %WS_TabStop Or %SS_Notify, Call CmdTriangleCancel
            Dialog Show Modeless hDlg
          Else
            v = Format$( x_, "0" ):       Control Set Text hDlg, 101, v
            v = Format$( y_, "0" ):       Control Set Text hDlg, 102, v
            v = Format$( halfSide_, "0" ):  Control Set Text hDlg, 103, v
          End If
          viewManager.GotoView( hDlg )
        End Method
     
        Method New( ByRef obj As iShape )
          obj = Class "cTriangle"
        End Method
     
        Method Hit( ByVal x As Long, ByVal y As Long ) As Long
          Dim dif As Long
          dif = ((2* halfSide_) - (y - (y_-halfSide_))) \ 2
          If y<y_+halfSide_ And y>y_-halfSide_ And x>=x_-dif And x<=x_+dif Then
            Method = -1
          Else
            Method = 0
          End If
        End Method
      End Interface
      Interface iTriangle
        Inherit IUnknown
     
        Property Get X() As Long
          Property = x_
        End Property
     
        Property Set X( value As Long )
          x_ = value
        End Property
     
        Property Get Y() As Long
          Property = y_
        End Property
     
        Property Set Y( value As Long )
          y_ = value
        End Property
     
        Property Get HalfSide() As Long
          Property = halfSide_
        End Property
     
        Property Set HalfSide( value As Long )
          halfSide_ = value
        End Property
      End Interface
    End Class
     
    CallBack Function CmdTriangleUpdate
      Local index As Long
      Local v As Variant
      Local shape As iShape
      Local triangle As iTriangle
      Local value As String
     
      index = GetShape( Cb.Hndl )
      If index=0 Then Exit Function
     
      v = drawList.Item(index)
      shape = v
      triangle = shape
      If IsInterface( triangle, iTriangle ) Then
        Control Get Text Cb.Hndl, 101 To value
        triangle.X = Val(value)
     
        Control Get Text Cb.Hndl, 102 To value
        triangle.Y = Val(value)
     
        Control Get Text Cb.Hndl, 103 To value
        triangle.HalfSide = Val(value)
     
        viewManager.CloseView()
        Call RedrawItems()
      End If
    End Function
     
    CallBack Function CmdTriangleCancel
      viewManager.CloseView()
      Call RedrawItems()
    End Function
     
    '===============================================================
    ' ViewManager
    '===============================================================
    ' By passing in the container an application can make decisions about the container
    ' such as it's size, placement, color, resizing strategy, etc.
    Sub NewViewManager( ByRef tm As iViewManager, hContainer As Dword )
      tm = Class "cViewManager"
      tm.Container = hContainer
    End Sub
     
    Class cViewManager
      Instance hContainer_ As Dword:                       ' Target
      Instance wStack_() As Dword:                         ' Stack of views
      Instance stackCount_ As Long:                        ' Current # of views we can "return" to
      Instance stackSize_ As Long:                         ' # of items in the stack
      Instance allowCloseAll_ As Long:                     ' <>0 if you want to allow the last view to be "Return"ed from.
     
      Class Method AllowOneMore()
        If stackCount_ >= stackSize_ Then
          stackSize_ += 10
          ReDim Preserve wStack_( stackSize_ -1 )
        End If
      End Method
      Class Method FitCurrent()
        Local w, h As Long
        Dialog Set Loc wStack_( stackCount_-1 ), 0, 0
        Dialog Get Size hContainer_ To w, h
        Dialog Set Size wStack_( stackCount_-1 ), w, h:    ' Set view to size of container i.e. "Fill" container
        Dialog Normalize wStack_( stackCount_-1 ):         ' Show the window we returned to
      End Method
     
      Interface iViewManager
        Inherit IUnknown
     
        ' Do we allow the last view to be closed?
        Property Set AllowCloseAll( value As Long )
          allowCloseAll_ = value                           ' 0 doesn't allow last view to close, 1 allows last view to close.
        End Property
     
        Property Get Container As Dword
          Property = hContainer_                          ' Get container
        End Property
        Property Set Container( value As Dword )
          hContainer_ = value                             ' Set container
        End Property
     
        Method GotoView( hView As Dword )
          ' "Goto" a view.  i.e. the view replaces the current view
          If Not IsWin( hView ) Then Exit Method
          If stackSize_<1 Then Call Me.AllowOneMore():    ' Ensure there's room for at least 1 view on the stack.
          If stackCount_ > 0 Then
            Dialog Hide wStack_( stackCount_-1 ):          ' Close the "current" view
          Else
            Incr stackCount_
          End If
          wStack_( stackCount_-1 ) = hView:               ' New view is "current" view
          Call Me.FitCurrent():                           ' Fit new view to container
        End Method
     
        Method CloseView()
          ' "Return" to a previous view
          Local w, h, mn As Long
          mn = IIf&( allowCloseAll_, 0, 1 )
          If stackCount_ <= mn Then Exit Method:          ' Ensure it's legitimate to close a view.
          Dialog Hide wStack_( stackCount_-1 ):            ' Close the current view
          Decr stackCount_
          If stackCount_>0 Then Call Me.FitCurrent():     ' Fit last view to container
        End Method
      End Interface
    End Class
    Revisions:
    Added link to zip file
    Fixed dialog styles, filled shapes so easier to see what will be selected when clicking.
    Last edited by Larry Charlton; 30 Nov 2014, 02:50 AM. Reason: Added a link to a zip file.
    LarryC
    Website
    Sometimes life's a dream, sometimes it's a scream
Working...
X