• 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

    • I see the Winblows 11 BETA testing continues. This is just Windows 10 all over again. Oh well, everything is still smooth sailing over here on Windows 10 21H2 LTSC. You unpaid sheep BETA testers be sure to let us know when you get done BETA testing Winblows 11 for the rest of us. 🤣
    • What do you expect? Windows 11 is still in BETA. This is Windows 10 all over again. M$ doesn't hire people to do BETA testing anymore. They just let all the dumb sheep with FOMO do all the BETA testing for them. It's the same dumb sheep who use self-checkout at the store and do someone else's job for FREE! All while the worker who's getting paid just stands there and watches them. 🤣 🤡
    • Pet peeve: Microsoft using scaling options to get around the fact they removed font size settings, as if that's somehow acceptable to do. Thankfully third party apps still can adjust font sizes just fine, even though it often randomly resets on OS updates. And the funny thing is that not only are the scaling options horrible crutches, but they only work in some applications. And, ironically enough, even some apps from Microsoft themselves have hardcoded tiny fonts in certain dialogs in them. Example - certain parts of MS Office apps UI.
    • Unofficial script does the most useful official Windows 11/10 repairs you want automatically by Sayan Sen IT admins and system admins, and even home users have to run various Windows diagnostic runs from time to time in order to iron out or work around system problems. Last year, Microsoft published a guidance piece about various such native Windows apps, tools and utilities they include the like of Task Manager, Registry Editor, and more. Aside from them, Windows also comes with SFC (System File Checker) and DISM (Deployment Image Servicing and Management) to scan and fix corrupt and missing system files. Besides those, various other ways to help and diagnose network issues related to DNS (Domain Name System), among others, also exists. In order to save time running these, a Reddit user has created a new tool that automates all of these into a single package. The author writes that the Batch script (.BAT file) they have developed is "basically a one-stop script that can help clean up your system, run built-in diagnostics, fix common network issues, and generate system reports." The script is based on native Windows tools like netsh, ipconfig, systeminfo, among others, and the idea behind this is essentially to save time. The tool can be of help with Windows Update repairs, among others, something we all know is pretty common, and even Microsoft's own support articles may not prove to be helpful. Here is everything the utility can do for you: Run SFC, DISM, CHKDSK from a single menu Restart network adapters with auto-detection Flush or set DNS (Google, Cloudflare, or custom) Windows Update repair (resets services + cache) Generate system reports (saved as .txt files on Desktop) Show installed drivers Clean up temp files Registry backup and restore (manual) The latest version of the utility is now available for download on GitHub. The new version fixes issues related to admin privileges. As the script requires it to be run as an admin, it now restart itself to work in admin mode even if a user forgot to run it as an administrator. To download it, head over to its GitHub page here. The utility is named Windows Maintenance Tool. As always, though, make sure to back up your PC as this is an unofficial third-party app, and it's better if you test it first in a VM. Source: Lil_Batti (Reddit)
    • Come the hell on, do we need clickbait titles? "Overwatch 2" - 11 characters "a popular multiplayer hero shooter" - 34 characters What's the purpose here - delivering news or titles for clicks? I think we all know the answer. You're straying into "Number 7 on this list will SHOCK you" territory and while it may work on some crappy sites, this is why they are crappy sites. Just tell the story! Go back and look at popular articles that made Neowin what it was. Did they have headlines of "New OS from major technology conglomerate has astonishing new feature" or is it likely to tell the story succinctly and then elaborate within the content?
  • Recent Achievements

    • One Month Later
      CoolRaoul earned a badge
      One Month Later
    • First Post
      Kurotama earned a badge
      First Post
    • Collaborator
      Carltonbar earned a badge
      Collaborator
    • Explorer
      MusicLover2112 went up a rank
      Explorer
    • Dedicated
      MadMung0 earned a badge
      Dedicated
  • Popular Contributors

    1. 1
      +primortal
      508
    2. 2
      ATLien_0
      270
    3. 3
      +FloatingFatMan
      245
    4. 4
      +Edouard
      201
    5. 5
      snowy owl
      168
  • Tell a friend

    Love Neowin? Tell a friend!