Note
Access to this page requires authorization. You can try signing in or changing directories.
Access to this page requires authorization. You can try changing directories.
Sometimes you need to know which flags are set in an object, eg. a tablefield. There are a lot of consts and enums. ..
Because of being very lazy and slowly in brain I descided to write a function for this and put it in a little class.
'---------------------------------------------------------------------------------------
' Module : cBitSetInfo
' Type : Class
' Author : Jedeck, Sven
' eMail : sven@jedeck.de
' Date : 15.12.2014
' Version : 0.1
' Purpose : Seeking comfortable for set Bits/Consts/EnumValues
' Hints : As you are in general not able to look explicit to EMPTY/0/null (dont speaking about NULL) _
the class returns >> BitSetType_en.BST_0_Empty = 0 << when null/0 ist delivered. _
By combing a null value with others you wont get right result !! _
But in praxis combing with potential null/0 wont be a serious scenario _
' Licence : Free use for every case, but don't miss hint to author and _
do NOT claim for any rights to this.
' Methods : _
. _
1) GetBitSetType (SearchedBit_prm As Long, BitField_prm As Long) As BitSetType_en _
Returns set/state of Bit search result _
This is the main function of class _
. _
2) GetBitSetName (SearchedBit_prm As Long, BitField_prm As Long) As String _
Returns the Enum Value Name of the set from Bit search result _
. _
3) GetBitSetDesc (SearchedBit_prm As Long, BitField_prm As Long) As String _
Returns the Enum Value Name of the set from Bit search result _
. _
4) IsIn (SearchedBit_prm As Long, BitField_prm As Long) As Boolean _
Return Boolean if delivered Values are in Seek BitField _
Thats the "fast" and propably most used function
' Properties: No
' Private Procedures: _
. _
1) Class Init // Calls Init_PseudoConsts _
2) Init_PseudoConsts // _
Set values to string vars for getting information about the Enum: BitSetType_en _
3) RE_BitSetType _
Returns name and description of the EnumValues.
' Use Example:
' In Modul:
' ########
' Example Beginn
' ########
'Option Compare Database
'Option Explicit
'
'
'Enum tmp_en
' V1 = 1
' V2 = 2
' V3 = 4
' V4 = 8
' V5 = 16
' V6 = 32
' V7 = 64
' V8 = 128
'End Enum
'Public Sub main()
'
' Dim Search_lcl As tmp_en
' Dim Field_lcl As tmp_en
'
' Dim MyBitSet As New cBitSetInfo
'
' Search_lcl = V1 + V2 + V5
' Field_lcl = V1 + V2 + V3
'
' Debug.Print "----------"
' Debug.Print MyBitSet.IsIn(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetType(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetDesc(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetName(Search_lcl, Field_lcl)
'
' Search_lcl = V1 + V2 + V5
' Field_lcl = V1 + V2
'
' Debug.Print "----------"
' Debug.Print MyBitSet.IsIn(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetType(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetDesc(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetName(Search_lcl, Field_lcl)
'
' Search_lcl = V1 + V2 + V5
' Field_lcl = V1 + V2 + V7
'
' Debug.Print "----------"
' Debug.Print MyBitSet.IsIn(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetType(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetDesc(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetName(Search_lcl, Field_lcl)
'
' Search_lcl = V1 + V2 + V5
' Field_lcl = V0
'
' Debug.Print "----------"
' Debug.Print MyBitSet.IsIn(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetType(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetDesc(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetName(Search_lcl, Field_lcl)
'
' Search_lcl = V1 + V2 + V5
' Field_lcl = V0 + V1
'
' Debug.Print "----------"
' Debug.Print MyBitSet.IsIn(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetType(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetDesc(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetName(Search_lcl, Field_lcl)
'
' Search_lcl = V0 + V1 + V2 + V5
' Field_lcl = V1
'
' Debug.Print "----------"
' Debug.Print MyBitSet.IsIn(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetType(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetDesc(Search_lcl, Field_lcl)
' Debug.Print MyBitSet.GetBitSetName(Search_lcl, Field_lcl)
'
' Set MyBitSet = Nothing
'
'End Sub
' ########
' Example End
' ########
'
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
Public Enum BitSetType_en
BST____0_Error = -4
BST___0_MoreIn = -2
BST__0_EmptyBitField = -1
BST_0_Empty = 0
BST_1_NoOneIn = 1
BST_3_AllIn = 2
BST_4_Identic = 4
End Enum
Private _
Pcst_BST____0_Error_Desc As String, _
Pcst_BST___0_MoreIn_Desc As String, _
Pcst_BST__0_EmptyBitField_Desc As String, _
Pcst_BST_0_Empty_Desc As String, _
Pcst_BST_1_NoOneIn_Desc As String, _
Pcst_BST_3_AllIn_Desc As String, _
Pcst_BST_4_Identic_Desc As String
Private _
Pcst_BST____0_Error_Name As String, _
Pcst_BST___0_MoreIn_Name As String, _
Pcst_BST__0_EmptyBitField_Name As String, _
Pcst_BST_0_Empty_Name As String, _
Pcst_BST_1_NoOneIn_Name As String, _
Pcst_BST_3_AllIn_Name As String, _
Pcst_BST_4_Identic_Name As String
Private Enum RE_Type_en
Name_ReType
Desc_ReType
End Enum
' ########
Const EndOfDecl As String = "EndOfDecl"
' ########
'
'
Public Function GetBitSetType( _
SearchedBit_prm As Long, _
BitField_prm As Long _
) As BitSetType_en
' --------------------
' Procedure : GetBitSetType
' Purpose : _
Returns set/state of Bit search result _
This is the main function of class _
' ----------
Dim _
eReturn_lcl As BitSetType_en, _
Left_In As Integer, _
Right_In As Integer, _
Both_In As Integer, _
i As Integer, _
SearchBit As Integer, _
FieldBit As Integer
' ----------
On Error GoTo GetBitSetType_Error
' ----------
For i = 1 To 31
' ----------
If BitField_prm = 0 _
Then _
eReturn_lcl = BST__0_EmptyBitField: _
Exit For
If SearchedBit_prm = 0 _
Then _
eReturn_lcl = BST_0_Empty: _
Exit For
SearchBit = _
(SearchedBit_prm& And 2 ^ (i - 1)) _
/ _
2 ^ (i - 1)
FieldBit = _
(BitField_prm& And 2 ^ (i - 1)) _
/ _
2 ^ (i - 1)
' ----------
Select Case SearchBit _
+ _
FieldBit
Case 0
Case 1
' ----------
Select Case (SearchedBit_prm And 2 ^ (i - 1)) _
/ _
2 ^ (i - 1)
Case 0
Right_In = _
Right_In + 1
Case 1
Left_In = _
Left_In + 1
End Select
' ----------
Case 2
Both_In = _
Both_In + 1
End Select
' ----------
Next i
'-------------
If Left_In > 0 Then
eReturn_lcl = BST___0_MoreIn
ElseIf Both_In = 0 Then
eReturn_lcl = BST_1_NoOneIn
ElseIf Both_In > 0 And Right_In > 0 And Left_In = 0 Then
eReturn_lcl = BST_3_AllIn
ElseIf Both_In > 0 And Right_In = 0 And Left_In = 0 Then
eReturn_lcl = BST_4_Identic
End If
' ----------
GetBitSetType_Error:
Select Case Err
Case 0
GetBitSetType = _
eReturn_lcl
Case Else 'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetBitSetType of Klassenmodul cBitSetInfo"
GetBitSetType = _
BST____0_Error
End Select
End Function
' GetBitSetType
'
Public Function GetBitSetName( _
SearchedBit_prm As Long,
BitField_prm As Long _
) As String
'---------------------------------
' Procedure : GetBitSetName
' Purpose : Returns the Enum Value NAME of the set from Bit search result
'----------
Dim _
sReturn_lcl As String
'----------
On Error GoTo GetBitSetName_Error
'----------
sReturn_lcl = RE_BitSetType(GetBitSetType(SearchedBit_prm, BitField_prm), Name_ReType)
'----------
GetBitSetName_Error:
Select Case Err
Case 0
GetBitSetName = sReturn_lcl
Case Else 'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetBitSetName of Klassenmodul cBitSetInfo"
GetBitSetName = ""
End Select
End Function
' GetBitSetName
'
Public Function GetBitSetDesc( _
SearchedBit_prm As Long, _
BitField_prm As Long _
) As String
'---------------------------------
' Procedure : GetBitSetDesc
' Purpose : Returns the Enum Value DESCRIPTION of the set from Bit search result
'----------
Dim _
sReturn_lcl As String
'----------
On Error GoTo GetBitSetDesc_Error
'----------
sReturn_lcl = RE_BitSetType(GetBitSetType(SearchedBit_prm, BitField_prm), Desc_ReType)
'----------
GetBitSetDesc_Error:
Select Case Err
Case 0
GetBitSetDesc = sReturn_lcl
Case Else 'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetBitSetDesc of Klassenmodul cBitSetInfo"
GetBitSetDesc = "Error"
End Select
End Function
' GetBitSetDesc
'
Public Function IsIn( _
SearchedBit_prm As Long, _
BitField_prm As Long _
) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : IsIn
' Purpose : _
Return Boolean if delivered Values are in Seek BitField _
Thats the "fast" and propably most used function
'----------
Dim _
bReturn_lcl As Boolean, _
GetBitSet_lcl As BitSetType_en
'---------
On Error GoTo IsIn_Error
'---------
GetBitSet_lcl = _
GetBitSetType( _
SearchedBit_prm, _
BitField_prm _
)
If GetBitSet_lcl > BST_1_NoOneIn _
Then _
bReturn_lcl = True _
Else _
bReturn_lcl = False
'---------
IsIn_Error:
Select Case Err
Case 0
IsIn = bReturn_lcl
Case Else 'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IsIn of Klassenmodul cBitSetInfo"
IsIn = False
End Select
End Function
' IsIn
'
Private Sub Class_Initialize()
'---------------------------------
' Procedure : Class_Initialize
' Purpose : Calls Init_PseudoConsts
'----------
On Error GoTo Class_Initialize_Error
'----------
Call Init_PseudoConsts
'----------
Class_Initialize_Error:
Select Case Err
Case 0
Case Else 'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Class_Initialize of Klassenmodul cBitSetInfo"
End Select
End Sub
'
'
Private Sub Init_PseudoConsts()
'---------------------------------
' Procedure : Init_PseudoConsts
' Purpose : Set values for the "Pseudo"-Consts
'----------
On Error GoTo Init_PseudoConsts_Error
'----------
Pcst_BST____0_Error_Desc = "Error"
Pcst_BST___0_MoreIn_Desc = "More Values seeked then in SeekField"
Pcst_BST__0_EmptyBitField_Desc = "No Values in SeekField"
Pcst_BST_0_Empty_Desc = "Null/Error"
Pcst_BST_1_NoOneIn_Desc = "No Value found"
Pcst_BST_3_AllIn_Desc = "All submitted Values are inside Bitfield"
Pcst_BST_4_Identic_Desc = "Seeked values are 1:1 identic to Bitfield"
'-----------
Pcst_BST____0_Error_Name = "Pcst_BST____0_Error"
Pcst_BST___0_MoreIn_Name = "Pcst_BST___0_MoreIn"
Pcst_BST__0_EmptyBitField_Name = "Pcst_BST__0_EmptyBitField"
Pcst_BST_0_Empty_Name = "Pcst_BST_0_Empty"
Pcst_BST_1_NoOneIn_Name = "Pcst_BST_1_NoOneIn"
Pcst_BST_3_AllIn_Name = "Pcst_BST_3_AllIn"
Pcst_BST_4_Identic_Name = "Pcst_BST_4_Identic"
'----------
Init_PseudoConsts_Error:
Select Case Err
Case 0
Case Else 'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Init_PseudoConsts of Klassenmodul cBitSetInfo"
End Select
End Sub
' Init_PseudoConsts
'
Private Function RE_BitSetType( _
BitSetType_prm As BitSetType_en,
ReType_prm As RE_Type_en _
) As String
'---------------------------------
' Procedure : RE_BitSetType
' Purpose : Returns name and description of the EnumValues.
'----------
Dim _
sReturn_lcl As String, _
sReturnName_lcl As String, _
sReturnDesc_lcl As String
'----------
On Error GoTo RE_BitSetType_Error
'----------
Select Case BitSetType_prm
Case BST____0_Error
sReturnDesc_lcl = Pcst_BST____0_Error_Desc
sReturnName_lcl = Pcst_BST____0_Error_Name
Case BST___0_MoreIn
sReturnDesc_lcl = Pcst_BST___0_MoreIn_Desc
sReturnName_lcl = Pcst_BST___0_MoreIn_Name
Case BST__0_EmptyBitField
sReturnDesc_lcl = Pcst_BST__0_EmptyBitField_Desc
sReturnName_lcl = Pcst_BST__0_EmptyBitField_Name
Case BST_0_Empty
sReturnDesc_lcl = Pcst_BST_0_Empty_Desc
sReturnName_lcl = Pcst_BST_0_Empty_Name
Case BST_1_NoOneIn
sReturnDesc_lcl = Pcst_BST_1_NoOneIn_Desc
sReturnName_lcl = Pcst_BST_1_NoOneIn_Name
Case BST_3_AllIn
sReturnDesc_lcl = Pcst_BST_3_AllIn_Desc
sReturnName_lcl = Pcst_BST_3_AllIn_Name
Case BST_4_Identic
sReturnDesc_lcl = Pcst_BST_4_Identic_Desc
sReturnName_lcl = Pcst_BST_4_Identic_Name
Case Else
sReturnDesc_lcl = ""
sReturnName_lcl = ""
End Select
'----------
Select Case ReType_prm
Case Name_ReType
sReturn_lcl = sReturnName_lcl
Case Desc_ReType
sReturn_lcl = sReturnDesc_lcl
Case Else
sReturn_lcl = ""
End Select
'----------
'----------
RE_BitSetType_Error:
Select Case Err
Case 0
RE_BitSetType = sReturn_lcl
Case Else 'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure RE_BitSetType of Klassenmodul cBitSetInfo"
RE_BitSetType = ""
End Select
End Function
' RE_BitSetType
'