예, 가능합니다. 그래도 SAFEARRAY 서술자를 수동으로 만들어야 만 원본 배열 데이터의 하위 집합을 가리킬 수 있습니다.
Module1의 :
Public Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Public Declare Function PutMem4 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long
Public Declare Function PutMem8 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValueLow As Long, ByVal NewValueHigh As Long) As Long
모듈 2 :
Private Declare Function SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ppsaOut As Any) As Long
Private Declare Function SafeArrayDestroyDescriptor Lib "oleaut32" (psa As Any) As Long
Private Const S_OK As Long = 0
Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Public Function StrArrPtr(arr() As String, Optional ByVal IgnoreMe As Long = 0) As Long
GetMem4 VarPtr(IgnoreMe) - 4, VarPtr(StrArrPtr)
End Function
Public Function UDTArrPtr(ByRef arr As Variant) As Long
If VarType(arr) Or vbArray Then
GetMem4 VarPtr(arr) + 8, VarPtr(UDTArrPtr)
Else
Err.Raise 5, , "Variant must contain array of user defined type"
End If
End Function
Public Function CreateSAFEARRAY(ByVal ppBlankArr As Long, ByVal ElemSize As Long, ByVal pData As Long, ParamArray Bounds()) As Long
'ParamArray Bounds describes desired array dimensions in VB style
'bounds(0) - lower bound of first dimension
'bounds(1) - upper bound of first dimension
'bounds(2) - lower bound of second dimension
'bounds(3) - upper bound of second dimension
'etc
Dim i As Long
If (UBound(Bounds) - LBound(Bounds) + 1) Mod 2 Then Err.Raise 5, "SafeArray", "Bounds must contain even number of entries."
If SafeArrayAllocDescriptor((UBound(Bounds) - LBound(Bounds) + 1)/2, ByVal ppBlankArr) <> S_OK Then Err.Raise 5
GetMem4 ppBlankArr, VarPtr(CreateSAFEARRAY)
PutMem4 CreateSAFEARRAY + 4, ElemSize
PutMem4 CreateSAFEARRAY + 12, pData
For i = LBound(Bounds) To UBound(Bounds) - 1 Step 2
If Bounds(i + 1) - Bounds(i) + 1 > 0 Then
PutMem8 CreateSAFEARRAY + 16 + (UBound(Bounds) - i - 1) * 4, Bounds(i + 1) - Bounds(i) + 1, Bounds(i)
Else
SafeArrayDestroyDescriptor ByVal CreateSAFEARRAY
CreateSAFEARRAY = 0
PutMem4 ppBlankArr, 0
Err.Raise 5, , "Each dimension must contain at least 1 element"
End If
Next
End Function
Public Function DestroySAFEARRAY(ByVal ppArray As Long) As Long
GetMem4 ppArray, VarPtr(DestroySAFEARRAY)
If SafeArrayDestroyDescriptor(ByVal DestroySAFEARRAY) <> S_OK Then Err.Raise 5
PutMem4 ppArray, 0
DestroySAFEARRAY = 0
End Function
사용법 :
Dim source(0 To 5) As Long
source(0) = 0: source(1) = 1: source(2) = 2: source(3) = 3: source(4) = 4: source(5) = 5
Dim a() As Long
Dim b() As Long
CreateSAFEARRAY ArrPtr(a), 4, VarPtr(source(0)), 0, 2
CreateSAFEARRAY ArrPtr(b), 4, VarPtr(source(3)), 0, 2
MsgBox b(0)
a(0) = 4
DestroySAFEARRAY ArrPtr(a)
DestroySAFEARRAY ArrPtr(b)
MsgBox source(0)
문자열의 배열에 대한 배열 (StrArrPtr
에 맞게 올바른 ArrPtr
맛을 사용해야합니다, UDTArrPtr
사용자 정의 유형 배열 01 다른 모든 항목의 경우).
원본 배열 변수가 erase
또는 범위를 벗어나 파괴되기 전에 수동으로 자식 배열을 파괴해야합니다.
그러나, 단지 서브 루틴을 참조하여, 전체 어레이를 통과하며 처리 시작까지의 인덱스 번호를 제공하는 것이 더 간단 할 수있다.
나는 이것이 복잡하다고 생각하지 않았습니다. 객체의 배열을 정렬하는 단순한 목적을 위해, 이것은 실제로 너무 복잡 할 수도 있습니다. 게다가 VB 전문가가 아니기 때문에 Basic보다 C++를 배웠습니다. 디버깅과 인터넷 검색에 많은 시간을 할애 할 것입니다. ;) 어쨌든 고마워요! +1 – Kiruse
문서화되지 않은 함수'VarPtr' [here] (http://vb.mvps.org/tips/varptr.asp)에 대한 정보를 찾았습니다 – ja72
@ ja72 http://support.microsoft.com/kb/199824/en-us – GSerg