derived.cls

来自「VB圣经」· CLS 代码 · 共 59 行

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
Private Type InitData
    AggData(0) As AggregateData
    IIDs() As VBGUID
End Type

Private m_Data As modDerived.OwnedBaseData
Private m_Hook As UnknownHook
Private m_Base As Base

Private Sub Class_Initialize()
Dim InitData As InitData
    Set m_Base = New Base
    InitArrayOwner m_Data.Owner, LenB(m_Data.Data(0)), 0
    m_Data.Owner.SA.pvData = m_Base.DataPtr
    With m_Data.Data(0)
        InitPushParamThunk .OverrideMeThunk, ObjPtr(Me), AddressOf modDerived.Base_OverrideMe
    End With
    
    With InitData
        With .AggData(0)
            Set .pObject = m_Base
            .Flags = adIgnoreIIDs
        End With
        VBoost.AggregateUnknown Me, .AggData, .IIDs, m_Hook
    End With
End Sub

Friend Function Base_OverrideMe() As String
    Base_OverrideMe = "Base.OverrideMe redirected to Derived"
End Function