既然决定要重新启用这个blog,那么就找点以前的东西贴上来充实下内容吧^_*
VB6中的指针模块
关键词: VB VB6 指针 模块
很久以前写的一个可以在VB6中实现指针的模块,用于对大量密集数据进行操作(比如per Pixel的图像运算)。
标准支持Byte,Integer,Long,Boolean,四种数据类型的指针,当然还可以很容易修改成为其它类型。 方便程度还行, 速度很快(当然前提要编译成本地EXE),在大量数据运算或密集内存访问的时候还是非常有用的。
' ================ ***** VB6 Pointer Module ***** ===================
' ================ You can use the pointer like in VC ===================
' ================ Copyright: sandy_zc_1 ===================
' ================ #### Email:sandy_zc_1@163.com #### ===================
' =============================================================================================================
' =============================================================================================================
' ================ ***** VB6 指针模块 ***** ===================
' ================ 你可以像在VC中一样使用指针 ===================
' ================ 版权所有: sandy_zc_1 ===================
' ================ #### Email:sandy_zc_1@163.com #### ===================
' =============================================================================================================
Public Declare Sub CopyMemory() Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function VarPtrArray()Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
'--------------------------------
'--VB指针结构---------
Public Type t_Pointer_Long1 '-----------------Long型指针
Inited1 As Boolean '-是否已初始化
Type1 As Long '-类型
PAddress1() As Long '-指针数据
PValue1() As Long '-指向的数据 (*操作符)
bkPAddrOrg1 As Long '-系统:释放用数据1 (原PAddr地址)
bkPValOrg1 As Long '-系统:释放用数据2 (原PVal地址)
End Type
Public Type t_Pointer_Integer1 '---------------Integer型指针
Inited1 As Boolean '-是否已初始化
Type1 As Long '-类型
PAddress1() As Long '-指针数据
PValue1() As Integer '-指向的数据 (*操作符)
bkPAddrOrg1 As Long '-系统:释放用数据1 (原PAddr地址)
bkPValOrg1 As Long '-系统:释放用数据2 (原PVal地址)
End Type
Public Type t_Pointer_Byte1 '-----------------Byte型指针
Inited1 As Boolean '-是否已初始化
Type1 As Long '-类型
PAddress1() As Long '-指针数据
PValue1() As Byte '-指向的数据 (*操作符)
bkPAddrOrg1 As Long '-系统:释放用数据1 (原PAddr地址)
bkPValOrg1 As Long '-系统:释放用数据2 (原PVal地址)
End Type
Public Type t_Pointer_Boolean1 '---------------Boolean型指针
Inited1 As Boolean '-是否已初始化
Type1 As Long '-类型
PAddress1() As Long '-指针数据
PValue1() As Boolean '-指向的数据 (*操作符)
bkPAddrOrg1 As Long '-系统:释放用数据1 (原PAddr地址)
bkPValOrg1 As Long '-系统:释放用数据2 (原PVal地址)
End Type
'-------------------------------Long指针操作
Function InitPointerLong1()Function InitPointerLong1(pL1 As t_Pointer_Long1)
Dim PP1 As Long, tmpP1 As Long
Dim pAddrSt1 As Long, pValSt1 As Long
ReDim pL1.PAddress1(0 To 0) As Long
ReDim pL1.PValue1(0 To 0) As Long
pL1.Type1 = vbLong
PP1 = VarPtrArray(pL1.PAddress1)
CopyMemory pAddrSt1, ByVal PP1, 4
PP1 = VarPtrArray(pL1.PValue1)
CopyMemory pValSt1, ByVal PP1, 4
CopyMemory pL1.bkPAddrOrg1, ByVal (pAddrSt1 + 12), 4
CopyMemory pL1.bkPValOrg1, ByVal (pValSt1 + 12), 4
tmpP1 = pValSt1 + 12
CopyMemory ByVal (pAddrSt1 + 12), tmpP1, 4
pL1.Inited1 = True
End Function
Function SetPointerLong1()Function SetPointerLong1(pL1 As t_Pointer_Long1, ByRef Target1 As Long)
pL1.PAddress1(0) = VarPtr(Target1)
End Function
Function FreePointerLong1()Function FreePointerLong1(pL1 As t_Pointer_Long1)
Dim PP1 As Long, pAddrSt1 As Long
pL1.PAddress1(0) = pL1.bkPValOrg1
PP1 = VarPtrArray(pL1.PAddress1)
CopyMemory pAddrSt1, ByVal PP1, 4
CopyMemory ByVal (pAddrSt1 + 12), pL1.bkPAddrOrg1, 4
pL1.Inited1 = False
End Function
'-----------------------------Integer指针操作
Function InitPointerInteger1()Function InitPointerInteger1(pI1 As t_Pointer_Integer1)
Dim PP1 As Long, tmpP1 As Long
Dim pAddrSt1 As Long, pValSt1 As Long
ReDim pI1.PAddress1(0 To 0) As Long
ReDim pI1.PValue1(0 To 0) As Integer
pI1.Type1 = vbInteger
PP1 = VarPtrArray(pI1.PAddress1)
CopyMemory pAddrSt1, ByVal PP1, 4
PP1 = VarPtrArray(pI1.PValue1)
CopyMemory pValSt1, ByVal PP1, 4
CopyMemory pI1.bkPAddrOrg1, ByVal (pAddrSt1 + 12), 4
CopyMemory pI1.bkPValOrg1, ByVal (pValSt1 + 12), 4
tmpP1 = pValSt1 + 12
CopyMemory ByVal (pAddrSt1 + 12), tmpP1, 4
pI1.Inited1 = True
End Function
Function SetPointerInteger1()Function SetPointerInteger1(pI1 As t_Pointer_Integer1, ByRef Target1 As Integer)
pI1.PAddress1(0) = VarPtr(Target1)
End Function
Function FreePointerInteger1()Function FreePointerInteger1(pI1 As t_Pointer_Integer1)
Dim PP1 As Long, pAddrSt1 As Long
pI1.PAddress1(0) = pI1.bkPValOrg1
PP1 = VarPtrArray(pI1.PAddress1)
CopyMemory pAddrSt1, ByVal PP1, 4
CopyMemory ByVal (pAddrSt1 + 12), pI1.bkPAddrOrg1, 4
pI1.Inited1 = False
End Function
'-----------------------------Byte指针操作
Function InitPointerByte1()Function InitPointerByte1(pByte1 As t_Pointer_Byte1)
Dim PP1 As Long, tmpP1 As Long
Dim pAddrSt1 As Long, pValSt1 As Long
ReDim pByte1.PAddress1(0 To 0) As Long
ReDim pByte1.PValue1(0 To 0) As Byte
pByte1.Type1 = vbByte
PP1 = VarPtrArray(pByte1.PAddress1)
CopyMemory pAddrSt1, ByVal PP1, 4
PP1 = VarPtrArray(pByte1.PValue1)
CopyMemory pValSt1, ByVal PP1, 4
CopyMemory pByte1.bkPAddrOrg1, ByVal (pAddrSt1 + 12), 4
CopyMemory pByte1.bkPValOrg1, ByVal (pValSt1 + 12), 4
tmpP1 = pValSt1 + 12
CopyMemory ByVal (pAddrSt1 + 12), tmpP1, 4
pByte1.Inited1 = True
End Function
Function SetPointerByte1()Function SetPointerByte1(pByte1 As t_Pointer_Byte1, ByRef Target1 As Byte)
pByte1.PAddress1(0) = VarPtr(Target1)
End Function
Function FreePointerByte1()Function FreePointerByte1(pByte1 As t_Pointer_Byte1)
Dim PP1 As Long, pAddrSt1 As Long
pByte1.PAddress1(0) = pByte1.bkPValOrg1
PP1 = VarPtrArray(pByte1.PAddress1)
CopyMemory pAddrSt1, ByVal PP1, 4
CopyMemory ByVal (pAddrSt1 + 12), pByte1.bkPAddrOrg1, 4
pByte1.Inited1 = False
End Function
'-----------------------------Boolean指针操作
Function InitPointerBoolean1()Function InitPointerBoolean1(pBool1 As t_Pointer_Boolean1)
Dim PP1 As Long, tmpP1 As Long
Dim pAddrSt1 As Long, pValSt1 As Long
ReDim pBool1.PAddress1(0 To 0) As Long
ReDim pBool1.PValue1(0 To 0) As Boolean
pBool1.Type1 = vbBoolean
PP1 = VarPtrArray(pBool1.PAddress1)
CopyMemory pAddrSt1, ByVal PP1, 4
PP1 = VarPtrArray(pBool1.PValue1)
CopyMemory pValSt1, ByVal PP1, 4
CopyMemory pBool1.bkPAddrOrg1, ByVal (pAddrSt1 + 12), 4
CopyMemory pBool1.bkPValOrg1, ByVal (pValSt1 + 12), 4
tmpP1 = pValSt1 + 12
CopyMemory ByVal (pAddrSt1 + 12), tmpP1, 4
pBool1.Inited1 = True
End Function
Function SetPointerBoolean1()Function SetPointerBoolean1(pBool1 As t_Pointer_Boolean1, ByRef Target1 As Boolean)
pBool1.PAddress1(0) = VarPtr(Target1)
End Function
Function FreePointerBoolean1()Function FreePointerBoolean1(pBool1 As t_Pointer_Boolean1)
Dim PP1 As Long, pAddrSt1 As Long
pBool1.PAddress1(0) = pBool1.bkPValOrg1
PP1 = VarPtrArray(pBool1.PAddress1)
CopyMemory pAddrSt1, ByVal PP1, 4
CopyMemory ByVal (pAddrSt1 + 12), pBool1.bkPAddrOrg1, 4
pBool1.Inited1 = False
End Function
使用方法很简单,添加到VB6的工程中去,若需要一个Byte型指针,就定义一个 t_Pointer_Byte类型变量,然后调用InitPointerByte1把它初始化一下,就可以当指针用了。
要让它指向某个Byte变量a只需调用SetPointerByte1,把它和a传过去就可以。当然可以直接操作它的PAddress1(0)成员值来直接指定它指向的位置。获得指向区域的值(*运算)只需要访问它的PValue1(0)成员即可。
使用完成后不要忘了调用FreePointerByte1释放指针(不然VB6的IDE可能会崩掉)就OK了。其它类型的指针使用方法一模一样。
呵呵这样VB6中就可以很方便的使用指针了,当然这样调试的话要学会养成和C程序员一样先保存的习惯哟,毕竟使用指针相对来说还是比较危险的,IDE崩掉了没来得及保存代码别怪我啊,呵呵。
简单例子:
Dim p as t_Pointer_Byte1,a as Byte
InitPointerByte1(p) '初始化p
SetPointerByte1(p,a) '让p指向a
'这里可以试试指针的效果了:
p.PValue1(0)=10 '把指针指向的地方值设为10
debug.Print a '看看a的值变了没有
FreePointerByte1 (p) '释放p
End Sub
很久以前的代码了,因为觉得差不多够用,也没有做过进一步的改进。有意见或问题的可以留言。