• 0

[VB6] Boolean Function


Question

What needs to be changed or added for the following code to work? I program mostly in Java now, and I've forgotten alot of my Visual Basic.

Option Explicit

Private Sub cmdEncode_Click()

    Dim key1 As String
    Dim key2 As String
    
    key1 = UCase(txtKey1.Text)
    key2 = UCase(txtKey2.Text)
    
    If ValidateKey(key1, "Validating key 1...", "Key 1 not valid!") = False Then
        Exit Sub
    End If
    
    If ValidateKey(key2, "Validating key 2...", "Key 2 not valid!") = False Then
        Exit Sub
    End If
    
    Dim i As Integer
    
   
    For i = 1 To Len(key1)
        ProgressBar.Value = i

        Dim x As Integer
        For x = 0 To i - 1
            If lblKey1(x).Caption <> Mid(key1, i, 1) Then
                lblKey1(i - 1).Caption = Mid(key1, i, 1)
            End If
        Next x
    Next i
    
    
End Sub

Private Function ValidateKey(ByVal key As String, ByVal status As String, ByVal error As String) As Boolean
    
    Dim check(Len(key)) As String
    Dim i As Integer
    
    lblStatus.Caption = status
    ProgressBar.Min = 1
    ProgressBar.Max = Len(key)

    
    For i = 1 To Len(key)
        ProgressBar.Value = i
    
        Dim x As Integer
        For x = 0 To i - 1
            If check1(x) <> Mid(key, i, 1) Then
                check1(i - 1) = Mid(key, i, 1)
            Else
                ProgressBar.Value = 0
                lblStatus.Caption = error
                ValidateKey = False
                Exit Function
            End If
        Next x
    Next i
    
    ValidateKey = True
End Function

This throws the following error:

  Quote
Compile error:

Constant expression required

When you follow the debug it takes you to these lines:

Private Function ValidateKey(ByVal key As String, ByVal status As String, ByVal error As String) As Boolean
    
    Dim check(Len(key)) As String

It highlights the function with yellow and then selects the text "key" in "Len(key)" as the source of the error.

Link to comment
https://www.neowin.net/forum/topic/398028-vb6-boolean-function/
Share on other sites

15 answers to this question

Recommended Posts

  • 0

Alright, that worked beautifully! Thank you. I have another problem. This code does not do what it is supposed to do! >:-( I'm trying to scan a word to make sure that a letter is only used once in the whole string. If anyone can see why this code doesn't work, your help would be appreciated!

EDIT: Nevermind, very simple logic mistake, just had to change the order of the if and the second for loop! Thanks again for the help!

Edited by Delox
  • 0

Once again, it was a simple mistake. I have a new problem with a sub routine. I'm trying to make it fill the remaining labels in a row with letters from the alphabet that are not used. So far the program looks like this:

Option Explicit

Private Sub cmdEncode_Click()

    Dim key1 As String
    Dim key2 As String
    
    key1 = UCase(txtKey1.Text)
    key2 = UCase(txtKey2.Text)
    
    If ValidateKey(key1, "Validating key 1...", "Key 1 not valid!") = False Then
        Exit Sub
    End If
    
    If ValidateKey(key2, "Validating key 2...", "Key 2 not valid!") = False Then
        Exit Sub
    End If
    
    Dim i As Integer
    
    ProgressBar.Min = 0
    ProgressBar.Max = Len(key1)
    lblStatus.Caption = "Assigning headers..."
    For i = 1 To Len(key1)
        ProgressBar.Value = i

        Dim x As Integer
        For x = 0 To i - 1
            If lblKey1(x).Caption <> Mid(key1, i, 1) Then
                lblKey1(i - 1).Caption = Mid(key1, i, 1)
            End If
        Next x
    Next i
    
    Call finishRow(-1, i)
    
    lblStatus.Caption = "Done!"
End Sub

Private Sub finishRow(ByVal row As Integer, ByVal pos As Integer)
    ProgressBar.Min = pos
    ProgressBar.Max = UBound(lblKey1) - pos
    lblStatus.Caption = "Assigning headers..."
    
    Dim asc As Integer
    asc = asc("A")
    
    If row = -1 Then
        Dim i As Integer
        
        For i = pos To 25
            ProgressBar.Value = i
            Dim x As Integer
            
            For x = 0 To i
                If asc = lblKey1(x) Then
                    asc = asc + 1
                End If
            Next x
            
            lblKey1(i).Caption = Chr(asc)
        Next i
    End If
End Sub

Private Function ValidateKey(ByVal key As String, ByVal status As String, ByVal error As String) As Boolean
    ProgressBar.Value = 0
    
    If Len(key) = 0 Then
        ProgressBar.Value = ProgressBar.Max
        lblStatus.Caption = error
        ValidateKey = False
        Exit Function
    End If
    
    Dim check() As String
    ReDim check(Len(key))
    
    Dim i As Integer
    
    For i = 1 To Len(key)
        check(i - 1) = Mid(key, i, 1)
    Next i
    
    lblStatus.Caption = status
    ProgressBar.Min = 0
    ProgressBar.Max = Len(key)

    
    For i = 0 To Len(key)
        ProgressBar.Value = i
        
        Dim x As Integer
        For x = 0 To i - 1
            Dim s As String
            
            s = Mid(key, i, 1)
            If asc(s) < asc("A") Or asc(s) > asc("Z") Then
                ProgressBar.Value = ProgressBar.Max
                lblStatus.Caption = error
                ValidateKey = False
                Exit Function
            End If
            
            If x <> i - 1 And check(x) = s Then
                ProgressBar.Value = ProgressBar.Max
                lblStatus.Caption = error
                ValidateKey = False
                Exit Function
            End If
        Next x
    Next i
    
    ValidateKey = True
    
End Function

Private Sub Form_Load()
    Dim i As Integer
    Dim c As Integer
    
    c = asc("A")
    
    For i = 0 To 25
        lblKey1(i).Caption = Chr(c)
        c = c + 1
    Next i
    
    For i = 0 To 9
        lblRow(i).Caption = i
    Next i
End Sub

At this point:

Private Sub finishRow(ByVal row As Integer, ByVal pos As Integer)

it shows the error:

  Quote
Compile error:

Expected array

Once again, I have no idea what the problem is. I haven't used Visual Basic 6 in a while...

  • 0

For i = pos To 25

ProgressBar.Value = i

Dim x As Integer

For x = 0 To i

If asc = lblKey1(x) Then

asc = asc + 1

End If

Next x

lblKey1(i).Caption = Chr(asc)

Next i

looks a little dodgy, you're comparing an int asc to a label control for equality? (Don't rely on default props)

asc never gets reset in any of the loops. Is this correct? :unsure

  • 0

asc doesn't need to be reset, as this part of the code only runs once. There will be an else section here where it will figure out which row the user is at, and use a second (10 letter) keyword to shift the alphabetical letters as far right as that postion, and print the alphabet from that point on, looping back to A, like this:

key 1 = nosamechr

key 2 = chrnotsame (this key MUST be 10 letters, which will be added later)

I need to create a table like this one below:

   | N O S A M E C H R B D F G I J K L P Q T U V W X Y Z
--+----------------------------------------------------
0 | C D E F G H I J K L M N O P Q R S T U V W X Y Z A B
1 | H I J K L M N O P Q R S T U V W X Y Z A B C D E F G
2 | R S T U V W X Y Z A B C D E F G H I J K L M N O P Q
3 | N O P Q R S T U V W X Y Z A B C D E F G H I J K L M
4 | O P Q R S T U V W X Y Z A B C D E F G H I J K L M N
5 | T U V W X Y Z A B C D E F G H I J K L M N O P Q R S
6 | S T U V W X Y Z A B C D E F G H I J K L M N O P Q R
7 | A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
8 | M N O P Q R S T U V W X Y Z A B C D E F G H I J K L
9 | E F G H I J K L M N O P Q R S T U V W X Y Z A B C D

A call to the sub finishRow(ByVal row As Integer, ByVal pos As Integer) which is "finishRow(-1, i) should complete the first line of letters (row X). I will latter add code to scan a word, take each letter and assign it to a row. It will start the alphabet from that letter, and then complete the row. Row 2 for example starts with "R" the alphabet is then finished and it loopes back to the start to complete the row.

Hopefully this will help you understand what I'm trying to accomplish. If you can think of a better way of doing this, any help would be appreciated!

  • 0

Here is the code to produce the grid using two keys ( I think this is what you want!)

I have sent the output to a text box for brevity but you could build a two dimensional array and then populate labels or create labels dynamicaly

Hope it makes sense:

Option Explicit

Private mAlphabet(25) As String

Private Sub BuildAlphabet()

Dim i As Integer

For i = 0 To 25

mAlphabet(i) = Chr(CLng(Asc("A") + i))

Next i

End Sub

Private Function BuildHeaderLine(key As String) As String

Dim ret As String

Dim i As Integer

ret = key

For i = 0 To 25

If InStr(1, key, mAlphabet(i)) = 0 Then

ret = ret & mAlphabet(i)

End If

Next i

BuildHeaderLine = ret

End Function

Private Function BuildLine(letter As String) As String

Dim ret As String

ret = letter

Dim startPos As Integer

startPos = Asc(letter) - Asc("A") + 1

Dim i As Integer

For i = startPos To startPos + 24

ret = ret & mAlphabet(i Mod 26)

Next i

BuildLine = ret

End Function

Private Sub Command1_Click()

Dim key1 As String

Dim key2 As String

key1 = UCase("nosamechr")

key2 = UCase("chrnotsame")

Call BuildAlphabet

Text1.Text = BuildHeaderLine(key1) + vbCrLf

Dim i As Integer

Dim letter As String

For i = 1 To Len(key2)

letter = Mid$(key2, i, 1)

Text1.Text = Text1.Text + BuildLine(letter) + vbCrLf

Next i

End Sub

  • 0

I've got to admit, you used some techniques there I would have never thought of! Using inStr to see if a character is used should have been obvious. The real genious is in using modulus to figure out the characters to complete the lines.

I have few more questions though:

How exactly would you go about putting this information into an array?? What I need to be able to do is reference a letter in the body using it's row number and the letter in the header for the column, as is seen on this page. It should be simple once I know how to create the table, either in memory, or as an actual table using label boxes. Any thoughts?

  • 0

Option Explicit

Private mAlphabet(25) As String


Private mOutputTable(10, 25) As String


Private Sub BuildAlphabet()
Dim i As Integer
    For i = 0 To 25
        mAlphabet(i) = Chr(CLng(Asc("A") + i))
    Next i

End Sub

Private Function BuildHeaderLine(key As String) As String
Dim ret As String
Dim i As Integer

    ret = key
    
    For i = 0 To 25
        If InStr(1, key, mAlphabet(i)) = 0 Then
            ret = ret & mAlphabet(i)
        End If
    Next i
    

    BuildHeaderLine = ret
End Function

Private Function BuildLine(letter As String, lineNo As Integer) As String
    Dim ret As String
    
    ret = letter
    mOutputTable(lineNo, 0) = letter
    
    
    Dim startPos As Integer
    
    startPos = Asc(letter) - Asc("A") + 1
    
    Dim i As Integer
    
    For i = startPos To startPos + 24
        mOutputTable(lineNo, i - startPos + 1) = mAlphabet(i Mod 26)
        ret = ret & mAlphabet(i Mod 26)
    Next i
    
    BuildLine = ret
End Function


Private Sub LetterAtPos(lineNumber As Integer, col As String, key As String)
Dim letter As String
Dim letterPos As Integer

    letterPos = InStr(1, key, col) - 1
    
    If letterPos > -1 Then
        letter = mOutputTable(lineNumber, letterPos)
        Call MsgBox("Letter Is: " + letter)
    Else
        Call MsgBox("Error")
    End If

End Sub



Private Sub Command1_Click()
    
    Dim key1 As String
    Dim key2 As String
    Dim columnKey As String
    
    key1 = UCase("nosamechr")
    key2 = UCase("chrnotsame")
    
    Call BuildAlphabet
    columnKey = BuildHeaderLine(key1)
    Text1.Text = columnKey + vbCrLf
    Text1.Text = Text1.Text + String(26, "=") + vbCrLf

Dim i As Integer
Dim j As Integer
Dim letter As String

    For i = 1 To Len(key2)
        letter = Mid$(key2, i, 1)
        Call BuildLine(letter, i - 1)
    Next i
    
    For i = 1 To Len(key2)
        For j = 0 To 25
            Text1.Text = Text1.Text + mOutputTable(i - 1, j)
        Next j
        Text1.Text = Text1.Text + vbCrLf
    Next i
    
    Call LetterAtPos(5, "R", columnKey)


End Sub

Should do it for you

This topic is now closed to further replies.
  • Recently Browsing   0 members

    • No registered users viewing this page.
  • Posts

    • The new official logo of the GOP
    • Linux 6.16-rc1 is out: What's new and what does it mean for your system? by Paul Hill Linus Torvalds, head and founder of the Linux kernel, has announced the closure of the merge window where major new features are added to the kernel, and the beginning of the Linux 6.16 release candidates, beginning with release candidate 1 (Linux 6.16-rc1). Linux 6.15 was released two weeks ago and in the time since, developers have had the opportunity to try and get their new kernel features into the Linux 6.16 kernel. Over the next two months, we will get seven or eight release candidates where developers will stabilize new and existing features. This means that the stable version of Linux 6.16 will arrive around the end of July. Torvalds said that the merge window seemed pretty normal this time, but did say he had a feeling that there were more “late straggler” pull requests than is typical. Despite this, everything seems to be fine and the schedule will be going forward as planned. Key areas of development Torvalds explained that around half of the changes in the first release candidate were driver updates, with the bulk of those being made up with by GPU and networking drivers. For end users these are the most important changes because when your favorite distribution of Linux ships a new release with this kernel, it will support more graphics cards and networking equipment like Wi-Fi cards. The non-driver updates in this version are split between architecture-specific updates, documentation and tooling (perf tool and selftests), and core changes to filesystems, core kernel, memory management, and networking. Torvalds said the core changes include some of the “most important” changes, though they’re not necessarily major changes. Fixes to the core ensure a more stable Linux kernel for end users, plus better performance. The merge window saw developers submit thousands of non-merge commits and merges. The non-merge commits were around 13,000 while the merge commits nearly reached 1,000. There were 1,783 unique authors submitting code during this window. Next steps Over the coming weeks, Linux developers, including individuals or representatives of companies, will submit bug fixes for new and existing features. This release candidate cycle will run until around the end of July and then the final version will become available. End users shouldn’t go out and download Linux 6.16 when it’s released, instead just wait for your Linux distribution to update to it, as distribution-specific changes get made. Neowin will be following these releases and reporting on any interested changes that are noted. Source: LKML
    • There was no cancelation. Microsoft delayed work on it to focus on further tuning the OS and improving the OS experience overall, before going full core into a direct hardware battle with their partners.
    • As someone who has 500+ hours of playtime on Anno 1800, all I can say is shut up and take my money.
  • Recent Achievements

    • Week One Done
      MadMung0 earned a badge
      Week One Done
    • Reacting Well
      BlakeBringer earned a badge
      Reacting Well
    • Reacting Well
      Lazy_Placeholder earned a badge
      Reacting Well
    • Dedicated
      Epaminombas earned a badge
      Dedicated
    • Veteran
      Yonah went up a rank
      Veteran
  • Popular Contributors

    1. 1
      +primortal
      474
    2. 2
      +FloatingFatMan
      273
    3. 3
      ATLien_0
      242
    4. 4
      snowy owl
      210
    5. 5
      Edouard
      182
  • Tell a friend

    Love Neowin? Tell a friend!