[VB6] Boolean Function

[Delox]

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.

[azcodemonkey]

It's been a while since I did VB, too, but I believe it's saying that you cannot use a variable to dimension an array. I think you need to dimension, and then redim it with the variable.

dim check() as string

redim check(len(key))

[Delox]

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 November 15, 2005 by Delox

[Delox]

I spoke too soon, this code does not work. Any ideas on what's wrong??

[Delox]

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...

[jimbo11883]

are you sure that lblKey1 is an array of labels on a form?

[Delox]

100% positive

[boddington]

Use

ProgressBar.Max = lblKey1.UBound - pos

[Delox]

  Quote

Use

ProgressBar.Max = lblKey1.UBound - pos

I noticed this after I posted the code. It's changed now, but it still throws the error at the same spot! :-(

[boddington]

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

[Delox]

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!

[boddington]

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

[Delox]

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?

[boddington]

Hang on and I'll post the code

[boddington]

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

[Delox]

Perfect. Exactly what I was looking for, thanks a million!