point.bas

VB圣经

Attribute VB_Name = "modPoints"
'***************************************************************
' (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

Private Type PointVTable
    VTable(6) As Long
End Type
Private m_VTable As PointVTable
Private m_pVTable As Long

Private Type StartVTable
    VTable(5) As Long
End Type
Private m_StartVTable As StartVTable
Private m_pStartVTable As Long

Private Type LinkedPoint
    pVTable As Long
    X As Long
    Y As Long
    Next As Long 'ILinkedPoint
End Type

Private Type StartingPoint
    pVTable As Long
    Next As Long 'IStartingPoint
    First As Long 'ILinkedPoint
    Last As ILinkedPoint
End Type

Public Const cPointMemMgrSize As Long = 16

Public Function NewPoint(MM As FixedSizeMemoryManager, ByVal X As Long, ByVal Y As Long) As ILinkedPoint
Dim Struct As LinkedPoint
Dim ThisPtr As Long
    If m_pVTable = 0 Then
        With m_VTable
            .VTable(0) = FuncAddr(AddressOf QueryInterface)
            .VTable(1) = FuncAddr(AddressOf AddRefRelease)
            .VTable(2) = .VTable(1)
            .VTable(3) = FuncAddr(AddressOf GetX)
            .VTable(4) = FuncAddr(AddressOf GetY)
            .VTable(5) = FuncAddr(AddressOf GetNext)
            .VTable(6) = FuncAddr(AddressOf SetNext)
            m_pVTable = VarPtr(.VTable(0))
        End With
    End If
    ThisPtr = MM.Alloc
    With Struct
        .pVTable = m_pVTable
        .X = X
        .Y = Y
        CopyMemory ByVal ThisPtr, Struct, LenB(Struct)
        CopyMemory NewPoint, ThisPtr, 4
    End With
End Function
Public Function NewStartingPoint(MM As FixedSizeMemoryManager, FirstPoint As ILinkedPoint, PrevStart As IStartingPoint) As IStartingPoint
Dim Struct As StartingPoint
Dim ThisPtr As Long
    If m_pStartVTable = 0 Then
        With m_StartVTable
            .VTable(0) = FuncAddr(AddressOf QueryInterface)
            .VTable(1) = FuncAddr(AddressOf AddRefRelease)
            .VTable(2) = .VTable(1)
            .VTable(3) = FuncAddr(AddressOf StartGetNext)
            .VTable(4) = FuncAddr(AddressOf StartGetFirst)
            .VTable(5) = FuncAddr(AddressOf StartAddPoint)
            m_pStartVTable = VarPtr(.VTable(0))
        End With
    End If
    ThisPtr = MM.Alloc
    With Struct
        .pVTable = m_pStartVTable
        .Next = ObjPtr(PrevStart)
        Set .Last = FirstPoint
        .First = ObjPtr(.Last)
        CopyMemory ByVal ThisPtr, Struct, LenB(Struct)
        CopyMemory NewStartingPoint, ThisPtr, 4
    End With
End Function
Private Function QueryInterface(ByVal This As Long, riid As Long, pvObj As Long) As Long
    'This actually never fires because we use only strong types.
    'Assert and fail just in case.
    Debug.Assert False
    pvObj = 0
    QueryInterface = E_NOINTERFACE
End Function
Private Function AddRefRelease(ByVal This As Long) As Long
    'Nothing to do
End Function

Private Function GetX(This As LinkedPoint) As Long
    GetX = This.X
End Function
Private Function GetY(This As LinkedPoint) As Long
    GetY = This.Y
End Function
Private Function GetNext(This As LinkedPoint) As Long 'ILinkedPoint
    GetNext = This.Next
End Function
Private Sub SetNext(This As LinkedPoint, pNext As Long) 'ILinkedPoint)
    This.Next = pNext
End Sub

Private Function StartGetNext(This As StartingPoint) As Long 'IStartingPoint
    StartGetNext = This.Next
End Function
Private Function StartGetFirst(This As StartingPoint) As Long 'ILinkedPoint
    StartGetFirst = This.First
End Function
Private Sub StartAddPoint(This As StartingPoint, pNew As ILinkedPoint)
    With This
        .Last.SetNext pNew
        Set .Last = pNew
    End With
End Sub
Private Function FuncAddr(ByVal pfn As Long) As Long
    FuncAddr = pfn
End Function