derived.cls

此源码为vb圣经编码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Derived"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'***************************************************************
Option Explicit

'Type for stack alloc in initialize
Private Type InitData
    AggData(0) As AggregateData
    IIDs(0) As VBGUID
End Type

Private m_Hook As UnknownHook
Private m_BaseOverride As BaseOverride
Private m_Base As Base

Private Sub Class_Initialize()
Dim InitData As InitData
Dim pBaseWrapped As IUnknown
Dim LastIID As LastIID
    
    'Get the IID for the base class.
    'This is required so that we can
    'set adFullyResolved on this IID.
    InitLastIID LastIID
    On Error Resume Next
    Set m_Base = LastIID.QIThis
    On Error GoTo 0
    
    Set m_Base = New Base
    
    With m_BaseOverride
        Set pBaseWrapped = VBoost.CreateDelegator(m_Base, m_Base, , VarPtr(.BD))
        modDerived.HookVTable .BD.pVTable
        .pDerived = ObjPtr(Me)
    End With
    
    With InitData
        With .AggData(0)
            .Flags = adUseIIDs Or adFullyResolved
            .FirstIID = 0
            Set .pObject = pBaseWrapped
        End With
        .IIDs(0) = LastIID.IID
        VBoost.AggregateUnknown Me, .AggData, .IIDs, m_Hook
    End With
End Sub

Friend Function Base_OverrideMe() As String
    Base_OverrideMe = m_Base.OverrideMe & _
      " overridden by Derived"
End Function