• 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

    • qBittorrent 5.1.1 by Razvan Serea The qBittorrent project aims to provide a Free Software alternative to µtorrent. qBittorrent is an advanced and multi-platform BitTorrent client with a nice user interface as well as a Web UI for remote control and an integrated search engine. qBittorrent aims to meet the needs of most users while using as little CPU and memory as possible. qBittorrent is a truly Open Source project, and as such, anyone can and should contribute to it. qBittorrent features: Polished µTorrent-like User Interface Well-integrated and extensible Search Engine Simultaneous search in most famous BitTorrent search sites Per-category-specific search requests (e.g. Books, Music, Movies) All Bittorrent extensions DHT, Peer Exchange, Full encryption, Magnet/BitComet URIs, ... Remote control through a Web user interface Nearly identical to the regular UI, all in Ajax Advanced control over trackers, peers and torrents Torrents queueing and prioritizing Torrent content selection and prioritizing UPnP / NAT-PMP port forwarding support Available in ~25 languages (Unicode support) Torrent creation tool Advanced RSS support with download filters (inc. regex) Bandwidth scheduler IP Filtering (eMule and PeerGuardian compatible) IPv6 compliant Available on most platforms: Linux, Mac OS X, Windows, OS/2, FreeBSD qBittorrent 5.1.1 changelog: BUGFIX: Don't interpret wildcard pattern as filepath globbing (glassez) BUGFIX: Fix appearance of search history length spinbox (glassez) BUGFIX: Remove dubious seeding time max value (glassez) BUGFIX: Fix ratio handling (glassez) BUGFIX: Fix compilation with Qt 6.6.0 (glassez) WEBUI: Make General tab text selectable by default (dezza) WEBUI: Add versioning to local preferences (Chocobo1) WEBUI: Make multi-rename search & replace fields use a monospace font (Atk) WEBUI: Fix wrong replacement sequence in IPv6 string (Chocobo1) WEBUI: Fix memory leak (bolshoytoster) WEBUI: Fix path autofill in set location and new category (tehcneko) RSS: Mark matched article as "read" if it refers to a duplicate torrent (glassez) WINDOWS: Update command line help message (KanishkaHalder1771) WINDOWS: NSIS: Don't require agreement on the license page (Chocobo1) LINUX: Fix preview not opening on Wayland (Isak05) LINUX: Add fallback for random number generator (Chocobo1) Download: qBittorrent 5.1.1 | Portable | ~40.0 MB (Open Source) Download: qBittorrent 64-bit installer (qt6) | 41.7 MB Links: qBittorrent Home page | Screenshot Get alerted to all of our Software updates on Twitter at @NeowinSoftware
    • Linus Torvalds releases a pretty ordinary Linux 6.16-rc3 by Paul Hill Linus Torvalds, the head and founder of the Linux kernel, has announced the release of Linux 6.16-rc3. This release comes with fixes for new features that were introduced during the merge window several weeks ago, and for old features where issues have been detected or improvements need to be made. If you remember last week, Torvalds said that rc2 seemed smaller than usual, putting it down to people going on vacation. He said this week’s rc3 seems to be in the usual ballpark for this time of the cycle, so everything looks “entirely normal.” In terms of changes, this release is “dominated” by wireless networking and GPU driver updates, however, Torvalds doesn’t think that anything really huge stands out this time. While nothing stands out Torvalds urged people to carry on testing and submitting patches. This update saw improvements to the core system and architecture. There have been improvements to ARM64 KVM that improve stability and correctness of virtualizations on ARM64. There are also improvements to RISC-V KVM and Trust Domain Extensions (TDX) for Intel which expand and secure virtualization capabilities on those architectures. On the graphics front, there are fixes for the amdgpu and amdkfd drivers that fix job handling, engine resets, display corruption, and power management features. The driver used for Qualcomm’s Adreno GPUs has been updated to improve fault handling, display timing, and driver binding. The open-source Nouveau (Nvidia) driver has been updated with fixes for GSP message queue references, potential integer overflows, buffer size adjustments, and a use-after-free bug. Finally, the Intel i915 driver has been updated to address early wedge issues, memory initializations, and build errors. There are also improvements to Wi-Fi devices (ath12k and iwlwifi), sound (ALSA), power management on AMD, and file system improvements (OverlayFS, EROFS, XFS, NFS, SunRPC). Linux 6.16 is due for release at the end of July and will then be picked up by Linux distributions, which will be the first interaction most end users have with the new features in this update. The main benefit of a newer kernel is that Linux will work on newer hardware, so if you’ve had issues with Linux, be sure to try it periodically in case your hardware is now supported.
    • Technically, it should be account-bound after activating it
  • Recent Achievements

    • Week One Done
      urbanmopdubai1 earned a badge
      Week One Done
    • One Month Later
      Jim Dugan earned a badge
      One Month Later
    • First Post
      Johnny Mrkvička earned a badge
      First Post
    • Week One Done
      viraltui earned a badge
      Week One Done
    • One Month Later
      serfegyed earned a badge
      One Month Later
  • Popular Contributors

    1. 1
      +primortal
      648
    2. 2
      Michael Scrip
      226
    3. 3
      ATLien_0
      219
    4. 4
      Steven P.
      150
    5. 5
      Xenon
      145
  • Tell a friend

    Love Neowin? Tell a friend!