'---------------------------------------------------------------------------------------
' 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
)
BitSetType_en _
Returns set/state of Bit search result _
This is the main function of class _
2) GetBitSetName (SearchedBit_prm
String
_
Returns the
Enum
Value Name of the set from Bit search result _
3) GetBitSetDesc (SearchedBit_prm
4) IsIn (SearchedBit_prm
Boolean
Return
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
: 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)
' Field_lcl = V1 + V2
' Field_lcl = V1 + V2 + V7
' Field_lcl = V0
' Field_lcl = V0 + V1
' Search_lcl = V0 + V1 + V2 + V5
' Field_lcl = V1
' Set MyBitSet = Nothing
'End Sub
' Example End
Option
Compare Database
Explicit
Public
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
Private
Pcst_BST____0_Error_Desc
, _
Pcst_BST___0_MoreIn_Desc
Pcst_BST__0_EmptyBitField_Desc
Pcst_BST_0_Empty_Desc
Pcst_BST_1_NoOneIn_Desc
Pcst_BST_3_AllIn_Desc
Pcst_BST_4_Identic_Desc
Pcst_BST____0_Error_Name
Pcst_BST___0_MoreIn_Name
Pcst_BST__0_EmptyBitField_Name
Pcst_BST_0_Empty_Name
Pcst_BST_1_NoOneIn_Name
Pcst_BST_3_AllIn_Name
Pcst_BST_4_Identic_Name
RE_Type_en
Name_ReType
Desc_ReType
Const
EndOfDecl
=
"EndOfDecl"
Function
GetBitSetType( _
SearchedBit_prm
BitField_prm
' --------------------
' Procedure : GetBitSetType
' Purpose : _
' ----------
Dim
eReturn_lcl
BitSetType_en, _
Left_In
Integer
Right_In
Both_In
i
SearchBit
FieldBit
On
Error
GoTo
GetBitSetType_Error
For
i = 1
To
31
If
BitField_prm = 0 _
Then
eReturn_lcl = BST__0_EmptyBitField: _
Exit
SearchedBit_prm = 0 _
eReturn_lcl = BST_0_Empty: _
SearchBit = _
(SearchedBit_prm&
And
2 ^ (i - 1)) _
/ _
2 ^ (i - 1)
FieldBit = _
(BitField_prm&
Select
Case
SearchBit _
+ _
0
1
(SearchedBit_prm
Right_In = _
Right_In + 1
Left_In = _
Left_In + 1
2
Both_In = _
Both_In + 1
Next
'-------------
Left_In > 0
eReturn_lcl = BST___0_MoreIn
ElseIf
Both_In = 0
eReturn_lcl = BST_1_NoOneIn
Both_In > 0
Right_In > 0
Left_In = 0
eReturn_lcl = BST_3_AllIn
Right_In = 0
eReturn_lcl = BST_4_Identic
GetBitSetType_Error:
Err
GetBitSetType = _
Else
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetBitSetType of Klassenmodul cBitSetInfo"
BST____0_Error
' GetBitSetType
GetBitSetName( _ SearchedBit_prm
Long _
'---------------------------------
' Procedure : GetBitSetName
' Purpose : Returns the Enum Value NAME of the set from Bit search result
'----------
sReturn_lcl
GetBitSetName_Error
sReturn_lcl = RE_BitSetType(GetBitSetType(SearchedBit_prm, BitField_prm), Name_ReType)
GetBitSetName_Error:
GetBitSetName = sReturn_lcl
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetBitSetName of Klassenmodul cBitSetInfo"
GetBitSetName =
""
' GetBitSetName
GetBitSetDesc( _ SearchedBit_prm
, _ BitField_prm
' Procedure : GetBitSetDesc
' Purpose : Returns the Enum Value DESCRIPTION of the set from Bit search result
GetBitSetDesc_Error
sReturn_lcl = RE_BitSetType(GetBitSetType(SearchedBit_prm, BitField_prm), Desc_ReType)
GetBitSetDesc_Error:
GetBitSetDesc = sReturn_lcl
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetBitSetDesc of Klassenmodul cBitSetInfo"
GetBitSetDesc =
"Error"
' GetBitSetDesc
IsIn( _
' Procedure : IsIn
bReturn_lcl
GetBitSet_lcl
'---------
IsIn_Error
GetBitSet_lcl = _
SearchedBit_prm, _
BitField_prm _
GetBitSet_lcl > BST_1_NoOneIn _
bReturn_lcl =
True
False
IsIn_Error:
IsIn = bReturn_lcl
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IsIn of Klassenmodul cBitSetInfo"
IsIn =
' IsIn
Sub
Class_Initialize()
' Procedure : Class_Initialize
' Purpose : Calls Init_PseudoConsts
Class_Initialize_Error
Call
Init_PseudoConsts
Class_Initialize_Error:
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Class_Initialize of Klassenmodul cBitSetInfo"
Init_PseudoConsts()
' Procedure : Init_PseudoConsts
' Purpose : Set values for the "Pseudo"-Consts
Init_PseudoConsts_Error
Pcst_BST____0_Error_Desc =
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:
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Init_PseudoConsts of Klassenmodul cBitSetInfo"
' Init_PseudoConsts
RE_BitSetType( _ BitSetType_prm
BitSetType_en, ReType_prm
RE_Type_en _ )
' Procedure : RE_BitSetType
' Purpose : Returns name and description of the EnumValues.
sReturnName_lcl
sReturnDesc_lcl
RE_BitSetType_Error
BitSetType_prm
sReturnDesc_lcl = Pcst_BST____0_Error_Desc
sReturnName_lcl = Pcst_BST____0_Error_Name
BST___0_MoreIn
sReturnDesc_lcl = Pcst_BST___0_MoreIn_Desc
sReturnName_lcl = Pcst_BST___0_MoreIn_Name
BST__0_EmptyBitField
sReturnDesc_lcl = Pcst_BST__0_EmptyBitField_Desc
sReturnName_lcl = Pcst_BST__0_EmptyBitField_Name
BST_0_Empty
sReturnDesc_lcl = Pcst_BST_0_Empty_Desc
sReturnName_lcl = Pcst_BST_0_Empty_Name
BST_1_NoOneIn
sReturnDesc_lcl = Pcst_BST_1_NoOneIn_Desc
sReturnName_lcl = Pcst_BST_1_NoOneIn_Name
BST_3_AllIn
sReturnDesc_lcl = Pcst_BST_3_AllIn_Desc
sReturnName_lcl = Pcst_BST_3_AllIn_Name
BST_4_Identic
sReturnDesc_lcl = Pcst_BST_4_Identic_Desc
sReturnName_lcl = Pcst_BST_4_Identic_Name
sReturnDesc_lcl =
sReturnName_lcl =
ReType_prm
sReturn_lcl = sReturnName_lcl
sReturn_lcl = sReturnDesc_lcl
sReturn_lcl =
RE_BitSetType_Error:
RE_BitSetType = sReturn_lcl
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure RE_BitSetType of Klassenmodul cBitSetInfo"
RE_BitSetType =
' RE_BitSetType