www.pudn.com > imagescale---raw.zip > BasPtr.bas

Attribute VB_Name = "BasPtr" 
Option Explicit 
 
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 
 
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long 
 
Public Type SAFEARRAY 
    cDims As Integer         '这个数组有几维？ 
    fFeatures As Integer     '这个数组有什么特性？ 
    cbElements As Long       '数组的每个元素有多大？ 
    cLocks As Long           '这个数组被锁定过几次？ 
    pvData As Long           '这个数组里的数据放在什么地方？ 
    'rgsabound() As SFArrayBOUND 
End Type 
 
Public Type SAFEARRAYBOUND 
    cElements As Long      '这一维有多少个元素？ 
    lLbound As Long        '它的索引从几开始？ 
End Type 
 
Public Type SAFEARRAY1 
    cDims As Integer         '这个数组有几维？ 
    fFeatures As Integer     '这个数组有什么特性？ 
    cbElements As Long       '数组的每个元素有多大？ 
    cLocks As Long           '这个数组被锁定过几次？ 
    pvData As Long           '这个数组里的数据放在什么地方？ 
    CE0 As Long              '这一维有多少个元素？ 
    LB0 As Long              '它的索引从几开始？ 
End Type 
 
Public Type SAFEARRAY2 
    cDims As Integer         '这个数组有几维？ 
    fFeatures As Integer     '这个数组有什么特性？ 
    cbElements As Long       '数组的每个元素有多大？ 
    cLocks As Long           '这个数组被锁定过几次？ 
    pvData As Long           '这个数组里的数据放在什么地方？ 
    CE0 As Long              '这一维有多少个元素？ 
    LB0 As Long              '它的索引从几开始？ 
    CE1 As Long 
    LB1 As Long 
End Type 
 
Public Const pvDataPtrAdd As Long = 12& 
 
 
'-- 关键变量 -------------------------------------- 
Public InitPtrFlag As Boolean 
 
Public pLongAll(0 To 0) As Long 
Public pLongAllPtr(0 To 0) As Long 
Public OldpLongAll As Long 
Public OldpLongAllPtr As Long 
 
'-- 2个3Byte指针 ---------------------------------- 
Public p3Byte0(0 To 2) As Byte 
Public p3Byte0Ptr(0 To 0) As Long 
Public Oldp3Byte0 As Long 
Public Oldp3Byte0Ptr As Long 
 
Public p3Byte1(0 To 2) As Byte 
Public p3Byte1Ptr(0 To 0) As Long 
Public Oldp3Byte1 As Long 
Public Oldp3Byte1Ptr As Long 
 
'-- 2个Long指针 ----------------------------------- 
Public pLong0(0 To 0) As Long 
Public pLong0Ptr(0 To 0) As Long 
Public OldpLong0 As Long 
Public OldpLong0Ptr As Long 
 
Public pLong1(0 To 0) As Long 
Public pLong1Ptr(0 To 0) As Long 
Public OldpLong1 As Long 
Public OldpLong1Ptr As Long 
 
 
Public Sub MakePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByRef OldArrPtr As Long, ByRef OldpArrPtr As Long) 
    Dim TempLng As Long 
    Dim TempPtr As Long 
     
    If InitPtrFlag Then 
        Dim OldPtr As Long 
         
        OldPtr = pLongAllPtr(0) 
        pLongAllPtr(0) = DataArrPtr 
        TempLng = pLongAll(0) + pvDataPtrAdd 
        pLongAllPtr(0) = pDataArrPtr 
        TempPtr = pLongAll(0) + pvDataPtrAdd 
        pLongAllPtr(0) = TempPtr 
        OldpArrPtr = pLongAll(0) 
        pLongAll(0) = TempLng 
        pLongAllPtr(0) = TempLng 
        OldArrPtr = pLongAll(0) 
        pLongAllPtr(0) = OldPtr 
         
    Else 
        CopyMemory TempLng, ByVal DataArrPtr, 4 '得到DataArrPtr的SAFEARRAY结构的地址 
        TempLng = TempLng + pvDataPtrAdd '这个指针偏移12个字节后就是pvData指针 
        CopyMemory TempPtr, ByVal pDataArrPtr, 4 '得到pDataArrPtr的SAFEARRAY结构的地址 
        TempPtr = TempPtr + pvDataPtrAdd '这个指针偏移12个字节后就是pvData指针 
        CopyMemory OldpArrPtr, ByVal TempPtr, 4  '保存旧地址 
        CopyMemory ByVal TempPtr, TempLng, 4  '使pDataArrPtr指向DataArrPtr的SAFEARRAY结构的pvData指针 
        CopyMemory OldArrPtr, ByVal TempLng, 4 '保存旧地址 
         
    End If 
     
End Sub 
 
Public Sub FreePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByVal OldArrPtr As Long, ByVal OldpArrPtr As Long) 
    Dim TempPtr As Long 
     
    If InitPtrFlag Then 
        pLongAllPtr(0) = DataArrPtr 
        pLongAllPtr(0) = pLongAll(0) + pvDataPtrAdd 
        pLongAll(0) = OldArrPtr 
        pLongAllPtr(0) = pDataArrPtr 
        pLongAllPtr(0) = pLongAll(0) + pvDataPtrAdd 
        pLongAll(0) = OldpArrPtr 
         
    Else 
        CopyMemory TempPtr, ByVal DataArrPtr, 4 '得到DataArrPtr的SAFEARRAY结构的地址 
        CopyMemory ByVal (TempPtr + pvDataPtrAdd), OldArrPtr, 4 '恢复旧地址 
        CopyMemory TempPtr, ByVal pDataArrPtr, 4 '得到pDataArrPtr的SAFEARRAY结构的地址 
        CopyMemory ByVal (TempPtr + pvDataPtrAdd), OldpArrPtr, 4 '恢复旧地址 
         
    End If 
     
End Sub 
 
Public Sub PointInit() 
    If InitPtrFlag Then Exit Sub 
     
    MakePoint VarPtrArray(pLongAll), VarPtrArray(pLongAllPtr), OldpLongAll, OldpLongAllPtr 
    InitPtrFlag = True 
     
    MakePoint VarPtrArray(p3Byte0), VarPtrArray(p3Byte0Ptr), Oldp3Byte0, Oldp3Byte0Ptr 
    MakePoint VarPtrArray(p3Byte1), VarPtrArray(p3Byte1Ptr), Oldp3Byte1, Oldp3Byte1Ptr 
     
    MakePoint VarPtrArray(pLong0), VarPtrArray(pLong0Ptr), OldpLong0, OldpLong0Ptr 
    MakePoint VarPtrArray(pLong1), VarPtrArray(pLong1Ptr), OldpLong1, OldpLong1Ptr 
     
End Sub 
 
Public Sub PointFree() 
    If InitPtrFlag = False Then Exit Sub 
     
    FreePoint VarPtrArray(p3Byte0), VarPtrArray(p3Byte0Ptr), Oldp3Byte0, Oldp3Byte0Ptr 
    FreePoint VarPtrArray(p3Byte1), VarPtrArray(p3Byte1Ptr), Oldp3Byte1, Oldp3Byte1Ptr 
     
    FreePoint VarPtrArray(pLong0), VarPtrArray(pLong0Ptr), OldpLong0, OldpLong0Ptr 
    FreePoint VarPtrArray(pLong1), VarPtrArray(pLong1Ptr), OldpLong1, OldpLong1Ptr 
     
    InitPtrFlag = False 
    FreePoint VarPtrArray(pLongAll), VarPtrArray(pLongAllPtr), OldpLongAll, OldpLongAllPtr 
     
End Sub