Store Multiple Booleans in an Integer

[AngelicGuardian]

I need a way of retrieving multiple booleans from one integer
and I wasn't sure if there was a better way then this:

Dim totalOfOptions  As Integer 
Dim currentOption   As Integer 
Dim currentAmount   As Integer 
Dim currentTotal    As Integer 
Dim totalOptions    As Integer 

While currentTotal <= totalOfOptions

    currentOption = currentOption + 1
    If (currentAmount = 0) Then
        currentAmount = currentAmount + 1
    Else
        currentAmount = currentAmount * 2
    End If
    currentTotal = currentTotal + currentAmount

Wend

Dim Options(0 To 255)    As Boolean 
totalOptions = currentOption


While currentOption > 0
    
    If (currentAmount <= totalOfOptions) Then
        Options(currentOption) = True
        totalOfOptions = totalOfOptions - currentAmount
    Else
        Options(currentOption) = False
    End If
    currentAmount = currentAmount / 2
    currentOption = currentOption - 1
Wend

 

[dcx693]

Why? What are you trying to achieve?

 

[AngelicGuardian]

Why? What are you trying to achieve?

I'm trying to store multiple booleans in one integer... thats easy
Option 1 = 1
Option 2 = 2
Option 3 = 4
Option 4 = 8
Option 5 = 16, etc..
but I don't want to have to go though every single number in the known universe making sure that the third option of a 3 option integer is true
so there has to be some way of subtracting the numbers faster then starting at 4.653138834498368145776998455562e+613 and working your way down

 

[dcx693]

How many possible booleans could you be storing? This isn't that uncommon. Visual Basic uses this same technique when storing multiple user options in functions like the Excel inputbox method.

 

[Eniac]

Here's a function I regularly use....

Basically, its doing a bitwise check on a number.

In my case, we one field to store multiple access rights for a system.

Examples of access rights are :

Update Project = 1
Add Project = 2
Delete Project = 4
Read Project = 8

Then field would store up to 15 (1 + 2 + 4 + 8)

So...
a guy with read only access would stored 8
a typical clerk would have Update & Add, thus, 3

when you want to check if a guy has a specific access you'd call the function BinaryTest ...

Const cUPDATE_PROJECT = 1
hasAccess = BinaryTest(adoRS("AccessRights), cUPDATE_PROJECT)

BUT!!! I'm not sure this is supported by VBA in Access.

This is something I use in Visual Basic 6.0 and ASP but last time I checked, I couldn't get it to work in VBA (Access)

if you need more info, let me know.

'**************************************************
'Name       : BinaryTest()
'Input      : prmintTest    : Value that needs to be checked
'             prmintSource  : Value against which a check will be performed
'Output     : Boolean, result of binary check
'--------------------------------------------------
'Definition : This is used to retrieve multiple flags
'             within an integer.
'             Values to check must not interfere with each other
'             So they need to follow a binary pattern : 1, 2, 4, 8, 16...etc
'             3 for instance is bad because it is a combination or 1 and 2 (in binary)
'
'Sample Usage : isAdmin = BinaryTest(arrUser(LNG_USER_RIGHTS), 128)
'**************************************************
Function BinaryTest(ByVal prmlngTest, ByVal prmlngSource)
Dim lngSource
Dim lngTest
Dim isOK

lngSource = ToLong(prmlngSource, 0)
lngTest   = ToLong(prmlngTest, 0)
isOK      = (Err.Number = 0)

If isOK Then
  isOK = ((lngSource And lngTest) > 0)
End If

BinaryTest = isOK
End Function
'**************************************************

 

[Eniac]

forgot to add this function,

its an homemade function that behaves more to my liking (won't crash on "empty" variables)

'**************************************************
Function ToLong(ByVal prmvarValue, ByVal prmlngDefault)
On Error Resume Next
Dim lngCrasher

lngCrasher = CLng(prmvarValue)
If (Err.Number <> 0) Or (prmvarValue & "x" = "x") Then
Err.Clear
lngCrasher = prmlngDefault
End If

ToLong = lngCrasher
End Function
'**************************************************