Tweet
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
Revisions:
Added link to zip file
Fixed dialog styles, filled shapes so easier to see what will be selected when clicking.
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
Added link to zip file
Fixed dialog styles, filled shapes so easier to see what will be selected when clicking.