数组维数的确定!

stanleypan

xEOubdPy.zip (8.63 KB, 下载次数: 199)

2006-3-30 20:05 上传

点击文件名下载附件
数组维数的确定!

stanleypan

Option Explicit
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long)
Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Const AppName = "Stanley Pan Hint:"

' ************************************************************************
' Routine Name : (Public in Standard module) Sub ArrayDimensionTest
' Written By : Stanley
' Programmer : Stanley [ISOLA-J05Q6EYMB]
' Date Writen : 2006-03-30 20:01:07
' Inputs : N/A
' Outputs : N/A
' Description :
' :
' :
' Called By :
' ************************************************************************
Public Sub ArrayDimensionTest()
Dim varArray() As Integer 'dim a variables to contain array
ReDim varArray(1) As Integer 'one dimension
MsgBox ArrayDims(VarPtrArray(varArray)), vbInformation, AppName

ReDim varArray(1, 2) As Integer 'two dimension
MsgBox ArrayDims(VarPtrArray(varArray)), vbInformation, AppName

ReDim varArray(2, 3, 4) As Integer 'three dimension
MsgBox ArrayDims(VarPtrArray(varArray)), vbInformation, AppName

ReDim varArray(1, 2, 3, 4) As Integer 'Four dimension
MsgBox ArrayDims(VarPtrArray(varArray)), vbInformation, AppName
End Sub
Public Function ArrayDims(ByVal lpArray As Long) As Integer
Dim lAddress As Long
CopyMemory lAddress, ByVal lpArray, 4
If lAddress = 0 Then
' The array isn't initilized
ArrayDims = -1
Exit Function
End If
CopyMemory ArrayDims, ByVal lAddress, 2
End Function

zw1028

斑竹老师：有点不明就里！能否解释一下。

7176386

强大。学习的人多，留下脚印。。。感谢。

lucytang1983

谢谢！学习了，