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.