Option Explicit Private Type SafeArray1 cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long cElements As Long lLbound As Long End Type Private Const FADF_AUTO = &H1 Private Const FADF_STATIC = &H2 Private Const FADF_FIXEDSIZE = &H10 Private Declare Function ArrPtr Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) Private Function IsWordCoumpoundOf(ByRef vsWord As String, ByRef vsLetters As String, Optional ByVal vbCanReuseLetters As Boolean = False) As Boolean Dim xbCount(128) As Integer Dim xbBuffer() As Byte Dim tArray As SafeArray1 Dim i As Long With tArray .cDims = 1 .cbElements = 1 .fFeatures = FADF_AUTO Or FADF_STATIC Or FADF_FIXEDSIZE CopyMemory ByVal ArrPtr(xbBuffer), VarPtr(tArray), 4 .cElements = LenB(vsWord) .pvData = StrPtr(vsWord) For i = 0 To .cElements - 1 Step 2 If vbCanReuseLetters Then xbCount(xbBuffer(i)) = -1 Else xbCount(xbBuffer(i)) = xbCount(xbBuffer(i)) - 1 End If Next i .cElements = LenB(vsLetters) .pvData = StrPtr(vsLetters) For i = 0 To .cElements - 1 Step 2 If vbCanReuseLetters Then xbCount(xbBuffer(i)) = 0 Else xbCount(xbBuffer(i)) = xbCount(xbBuffer(i)) + 1 End If Next i CopyMemory ByVal ArrPtr(xbBuffer), 0&, 4 End With IsWordCoumpoundOf = True For i = 0 To UBound(xbCount) If xbCount(i) < 0 Then IsWordCoumpoundOf = False Exit For End If Next i End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.