VB6－设计模式点滴

1、单件模式

Class：SingletonClass

Option   Explicit

Public  Count  As   Integer

Private   Sub  Class_Initialize()
     If  gSingleton  Is   Nothing   Then
         Set  gSingleton  =  Me
     End   If
End Sub

Public   Function  GetInstance()  As  SingletonClass
     Set  GetInstance  =  gSingleton
End Function

模块声明

Public  gSingleton  As  SingletonClass

2、方法继承
Class：IMethod

Public   Function  SetName(Name  As   String )
    SetName  =   Trim ( UCase (Name))
End Function

Class：NewMethod

Implements IMethod

Private  Base  As  IMethod

Private   Sub  Class_Initialize()
     Set  Base  =   New  IMethod
End Sub

Private   Sub  Class_Terminate()
     Set  Base  =   Nothing
End Sub

Private   Function  IMethod_SetName(Name  As   String )  As  Variant
    IMethod_SetName  =  Base.SetName(Name)
    IMethod_SetName  =  IMethod_SetName  &   " 0001 "
End Function

3：工厂模式：

CreateObject

4：ComUnit的一个设计模式

Implements ITestContainer

Public   Property   Get  ITestContainer_TestCaseNames()  As  Variant()
    ITestContainer_TestCaseNames  =   Array ( " TestString " )
End Property

Public   Sub  ITestContainer_RunTestCase(oTestCase  As  ITestCase, oTestResult  As  TestResult)
    CallByName Me, oTestCase.Name, VbMethod, oTestResult
End Sub

Public   Sub  TestString(oTestResult  As  TestResult)
End Sub

使用TestCaseNames向外暴露自身扩展的成员。

使用类似于TestString的方法（接口参数一致），来扩展自身功能。

借助TestResult来贯穿类处理的总线。

使用TestRunner来处理符合ITestContainer接口的类。

5：观察者模式

Option   Explicit
' Ineteface Subject
Public   Sub  Register(obs  As  Observer)
End Sub

Option   Explicit

' Interface Observer
Public   Sub  Notify(msg  As   String )
End Sub

' frmMain

Implements Subject

Dim  cc  As  Collection

Private   Sub  Command1_Click()
     Dim  c  As  Observer
     For   Each  c In cc
        c.Notify  InputBox ( " Caption: " )
     Next
End Sub

Private   Sub  Form_Load()
     Set  cc  =   New  Collection
     Dim  o  As  frm1
     Set  o  =   New  frm1
    o.Ini Me
    o.Show
    
     Dim  oo  As  frm2
     Set  oo  =   New  frm2
    oo.Ini Me
    oo.Show

End Sub

Private   Sub  Subject_Register(obs  As  Observer)
    cc.Add obs
End Sub


' frm1
Implements Observer

Public   Sub  Ini(s  As  Subject)
    s.Register Me
End Sub

Private   Sub  Observer_Notify(msg  As   String )
    Me.Caption  =  msg
End Sub

' frm2

Implements Observer

Public   Sub  Ini(s  As  Subject)
    s.Register Me
End Sub

Private   Sub  Observer_Notify(msg  As   String )
    Me.Caption  =  msg
End Sub