I know jumping around in code is not considered professional, but since I'm an amateur, is there a way to do that?
-
Welcome to B4X forum!
B4X is a set of simple and powerful cross platform RAD tools:
- B4A (free) - Android development
- B4J (free) - Desktop and Server development
- B4i - iOS development
- B4R (free) - Arduino, ESP8266 and ESP32 development
From VB6 to Basic4android
- Thread starter nfordbscndrd
- Start date
- Similar Threads Similar Threads
I'm afraid NOT.
You could do it with:
If ... Then
.
Else If ... Then
.
Else If ... Then
.
Else
.
End If
or with
Select Var
.
Case Var1
.
Case Var2
.
Case Else
.
End Select
If you have some trouble, post your code and we will help you.
Best regards.
You could do it with:
If ... Then
.
Else If ... Then
.
Else If ... Then
.
Else
.
End If
or with
Select Var
.
Case Var1
.
Case Var2
.
Case Else
.
End Select
If you have some trouble, post your code and we will help you.
Best regards.
Upvote
0
Is there list of all b4a language commands? I mean this version of Basic?? I have used various programming languages and sometimes it is bit confusing to remember what commands and their syntaxes are... I mean if-else, for-next etc.. (they are not problem but I just dont know what commands this b4a basic has..)
edit: Okay, core docs show them quite well, but what if I dont know what command name I'm looking, for example it would be nice for beginner to know commands by purpose, loops, conditional commands, etc. "basic language commands"
edit: Okay, core docs show them quite well, but what if I dont know what command name I'm looking, for example it would be nice for beginner to know commands by purpose, loops, conditional commands, etc. "basic language commands"
Last edited:
Upvote
0
Well, okay...
This is a Sub in a VB6 program which I am trying to convert to B4A. There's only two line labels and only one place each where they are referenced, so I didn't want to have to restructure this whole Sub just for those two little checks if there was some easier alternative.
I've got a couple of other subs which are more complex than this and have 5-6 jumps in them. These are things that come up after I've written 90+% of the code and have to try to plug in some little additions.
B4X:
Public Sub GetSuggestions( _
ByVal str_Word As String, _
ByVal sndx As String)
Dim n As Integer
Dim l As Integer
Dim best As Integer
Dim lev As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim tst1 As Integer
Dim tst2 As Integer
Dim tst3 As Integer
Dim tst4 As Integer
Dim sndx2 As String
Dim w As String
Dim w2 As String
Dim w3 As String
Dim cons As String
Dim cons2 As String
Dim c1 As String
Dim c2 As String
Dim keys(4) As String
Dim roW As Long
Dim col As Long
Dim adjacent As Boolean
Dim got1 As Boolean
Dim wID As Long
Dim q As Long
Dim q1 As Long
Dim q2 As Long
Dim q3 As Long
Dim sug(1000) As String
Dim capWord As String
Dim tempWord As String
Dim z As Long
Dim runOnWords() As String
Dim s As String
Dim changingSndx As Boolean
Dim originalSndx As String
If Len(str_Word) < 2 Then Exit Sub
lstSuggestions.Clear
lstSuggestions.Height = lb_Links.Height - b_CloseSuggestions.Height
lstSuggestions.Visible = True
b_CloseSuggestions.Visible = True
b_UseSuggestion.Visible = True
CheckSndx:
s = LCase$(Left$(str_Word, 1))
cons = Replace$(LCase$(str_Word), "a", "")
cons = Replace$(LCase$(cons), "e", "")
cons = Replace$(LCase$(cons), "i", "")
cons = Replace$(LCase$(cons), "o", "")
cons = Replace$(LCase$(cons), "u", "")
If InStr("aeiou", s) > 0 Then cons = s & cons
With WordsRS
' Swap out each letter and look for words: '
.Index = "Text"
k = Len(str_Word)
For i = 1 To k
w2 = str_Word
c1 = Mid$(w2, i, 1)
z = Asc(c1)
For j = 97 To 122
If j <> z Then
Mid$(w2, i, 1) = Chr$(j)
.Seek "=", w2
If Not .NoMatch Then
lstSuggestions.AddItem !Text
End If
End If
Next
Next
q1 = InStr(str_Word, "'")
q2 = InStr(q1 + 2, str_Word, "'")
q3 = InStr(q2 + 2, str_Word, "'")
If q1 > 1 And q2 > 0 Then
w2 = Left$(str_Word, q1 - 1)
.Seek ">=", w2
If Not .NoMatch Then
z = Len(w2)
q = Len(str_Word)
Do
Do While q <> Len(!Text) And w2 = LCase$(Left$(!Text, z))
.MoveNext
Loop
If w2 <> Left$(!Text, z) Then Exit Do
tempWord = !Text
Mid$(tempWord, q1) = "'"
Mid$(tempWord, q2) = "'"
If q3 > 0 Then Mid$(tempWord, q3) = "'"
If tempWord = str_Word Then
lstSuggestions.AddItem !Text
End If
.MoveNext
Loop
End If
End If
w = t_Word
MatchSndx:
.Index = "Soundex"
.Seek "=", sndx
If Not .NoMatch Then
CortexRS.Index = "WordID"
CortexRS.Seek "=", !id
If Not CortexRS.NoMatch Then
If CortexRS!linkID = 31015 Or CortexRS!linkID = 31040 Then
If Not IsNull(CortexRS!startID) Then
wID = CortexRS!startID
CortexRS.Index = "ID"
CortexRS.Seek "=", wID
If CortexRS.NoMatch Then Stop
If IsNull(CortexRS!WordID) Then Stop
.Index = "ID"
wID = CortexRS!WordID
.Seek "=", wID
If .NoMatch Then Stop
For i = 1 To 6: lstSuggestions.AddItem " ": Next
lstSuggestions.AddItem !Text, 0
Exit Sub
End If
End If
End If
Do While !Soundex = sndx
lstSuggestions.AddItem !Text
.MoveNext
If .NoMatch Then
Exit Do
End If
Loop
End If
If Left$(w, 2) = "aq" Then
w = "acq" & Mid$(w, 3)
sndx = Soundex(w)
GoTo MatchSndx
End If
w2 = sndx
c2 = Mid$(w2, 2, 1)
Mid$(w2, 2, 2) = Mid$(w2, 3, 1) & c2
.Seek ">=", w2
If Not .NoMatch Then
Do While Left$(!Soundex, Len(w2)) = w2
lstSuggestions.AddItem !Text
.MoveNext
If .EOF Then Exit Do
Loop
End If
' Swap 2nd-3rd digits (e.g.: 15 -> 51): '
w2 = sndx
c2 = Mid$(w2, 3, 1)
If Not (Mid$(w2, 4, 1) = "0" And c2 = "0") Then
' Don't swap one 0 for another. '
Mid$(w2, 3, 2) = Mid$(w2, 4, 1) & c2
.Seek ">=", w2
If Not .NoMatch Then
Do While !Soundex = w2
lstSuggestions.AddItem !Text
.MoveNext
If .EOF Then Exit Do
Loop
End If
End If
' See if text is a run-on word: '
If Len(str_Word) > 3 Then
int_Nested = 0
FindRunOns str_Word, ""
FindAffixes str_Word
End If
keys(0) = " "
keys(1) = " qwertyuiop "
keys(2) = " asdfghjkl '"
keys(3) = " zxcvbnm "
keys(4) = " "
' Check for dropped first letter: '
.Index = "Text"
For j = 97 To 122 ' a - z '
w2 = Chr$(j) & str_Word
.Seek "=", w2
If Not .NoMatch Then
lstSuggestions.AddItem w2
got1 = True
End If
Next
j = Len(str_Word)
For i = 1 To j
c1 = LCase$(Mid$(str_Word, i, 1))
c2 = LCase$(Mid$(str_Word, i + 1, 1))
If c2 = "'" And Right$(" " & str_Word, 3) = "in'" And i = j Then
' e.g.: runnin' '
w2 = ChopRight(str_Word, 1) & "g"
.Seek "=", w2
If Not .NoMatch Then
lstSuggestions.AddItem w2
got1 = True
End If
End If
If c2 = "-" Then Exit For
If c2 > "z" Then Stop: Exit For
col = InStr(keys(1), c2)
If col > 0 Then
roW = 1
Else
col = InStr(keys(2), c2)
If col > 0 Then
roW = 2
Else
col = InStr(keys(3), c2)
roW = 3
End If
End If
adjacent = False
For j = -1 To 1 ' row '
For k = 0 To 2 ' col '
If Mid$(keys(roW + j), col + k, 1) = c1 Then
adjacent = True
End If
w2 = Left$(str_Word, i - 1) & Mid$(str_Word, i + 1)
.Seek "=", w2
If Not .NoMatch Then
Do While !Text <> w2 And LCase$(!Text) = LCase$(w2)
.MoveNext
If .EOF Then Exit Do
Loop
If !Text = w2 Then
lstSuggestions.AddItem w2
got1 = True
End If
End If
Next
Next
If Not adjacent Then
col = InStr(keys(1), c1)
If col > 0 Then
roW = 1
Else
col = InStr(keys(2), c1)
If col > 0 Then
roW = 2
Else
col = InStr(keys(3), c1)
roW = 3
End If
End If
For j = -1 To 1
If roW + j = 0 Then j = 0 ' row 0 is blank '
For k = -1 To 1
w2 = str_Word
c2 = Mid$(keys(roW + j), col + k, 1)
If c2 <> " " Then
Mid$(w2, i, 1) = Mid$(keys(roW + j), col + k, 1)
.Seek "=", w2
If Not .NoMatch Then
Do While !Text <> w2 And LCase$(!Text) = LCase$(w2)
.MoveNext
If .EOF Then Exit Do
Loop
If !Text = w2 Then
lstSuggestions.AddItem w2
got1 = True
End If
End If
End If
Next
If roW + j = 3 Then Exit For ' row 4 is blank '
Next
End If
w2 = str_Word
Mid$(w2, i, 2) = Mid$(w2, i + 1, 1) & Mid$(w2, i, 1)
.Seek "=", w2
If Not .NoMatch Then
Do While !Text <> w2 And LCase$(!Text) = LCase$(w2)
.MoveNext
If .EOF Then Exit Do
Loop
If !Text = w2 Then
lstSuggestions.AddItem w2
got1 = True
End If
End If
If i < Len(str_Word) Then
w3 = str_Word
If Mid$(str_Word, i, 1) = "'" Then
w3 = Left$(w3, i - 1) & Mid$(w3, i + 1)
End If
For j = 97 To 122 ' a - z '
w2 = Left$(w3, i) & Chr$(j) & Mid$(w3, i + 1)
.Seek "=", w2
If .NoMatch Then
If i = 1 Then
w2 = Chr$(j) & w3
Else
w2 = Left$(w3, i - 1) & Chr$(j) & Mid$(w3, i)
End If
.Seek "=", w2
End If
If Not .NoMatch Then
Do While !Text <> w2 And LCase$(!Text) = LCase$(w2)
.MoveNext
If .EOF Then Exit Do
Loop
If !Text = w2 Then
lstSuggestions.AddItem w2
got1 = True
End If
End If
Next
End If
Next
For j = 97 To 122 ' a - z '
w2 = str_Word & Chr$(j)
.Seek "=", w2
If Not .NoMatch Then
Do While !Text <> w2 And LCase$(!Text) = LCase$(w2)
.MoveNext
If .EOF Then Exit Do
Loop
If !Text = w2 Then
lstSuggestions.AddItem w2
got1 = True
End If
End If
Next
If Left$(str_Word & " ", 3) = "non" Then
w2 = Mid$(str_Word, 4)
.Index = "Text"
.Seek "=", w2
If Not .NoMatch Then
lstSuggestions.AddItem "non" & w2
End If
End If
i = InStr(str_Word, "chu")
If i > 0 Then
w2 = Replace$(str_Word, "chu", "tu")
.Index = "Text"
.Seek "=", w2
If Not .NoMatch Then
lstSuggestions.AddItem w2
End If
End If
If InStr(str_Word, "-n-") > 0 Then ' May need to do this for 'n' as well. '
' cut-n-paste = cut-and-paste '
w2 = Replace$(str_Word, "-n-", "-and-")
.Index = "Text"
.Seek "=", w2
If Not .NoMatch Then
lstSuggestions.AddItem w2
End If
End If
End With
If originalSndx <> "" Then
' See code further down which '
' sets "originalSndx". '
i = Val(Right$(sndx, 1))
j = Val(Right$(originalSndx, 1))
i = i + 1
If i = j Then i = i + 1
If i < 10 Then
sndx = ChopRight(sndx, 1) & i
GoTo CheckSndx
End If
End If
' Filter suggestions to get reasonable matches: '
With lstSuggestions
If .ListCount > 0 Then
ReDim scores(1, .ListCount - 1) As Integer
ReDim hiQ(1) As Integer
i = 0
' Remove duplicates: '
Do While i < .ListCount - 1
Do While .List(i) = .List(i + 1)
.RemoveItem i
Loop
i = i + 1
Loop
If .ListCount = 0 Then
GoTo WikiList
End If
i = 0
Do While i < .ListCount
w3 = .List(i)
Do While InStr(.List(i), " ") > 0
i = i + 1
If i = .ListCount Then Exit Do
Loop
If i = .ListCount Then Exit Do
If str_Word <> w3 Then
If Abs(Len(str_Word) - Len(w3)) > 2 Then
scores(0, i) = 0
scores(1, i) = 0
Else
scores(0, i) = qGram(str_Word, w3) _
- Abs(Len(str_Word) _
- Len(w2))
scores(1, i) = nGram(str_Word, w3)
End If
For j = 0 To 1
If scores(j, i) > hiQ(j) Then
hiQ(j) = scores(j, i)
End If
Next
End If
i = i + 1
Loop
n = .ListCount - 1
For i = n To 0 Step -1
sug(i) = .List(i)
Do While InStr(.List(i), " ") > 0
sug(i) = .List(i)
i = i - 1
If i < 0 Then Exit For
Loop
If str_Word <> sug(i) Then
k = LevDist(str_Word, sug(i))
If k < 5 Or (sug(i) <> "zzzz" And scores(0, i) > 0 And _
(scores(1, i) > 0 Or _
Len(str_Word) < 4)) _
Then
tst1 = Len(str_Word) > 4 And _
hiQ(0) - scores(0, i) > 2
tst2 = Len(str_Word) > 2 And _
Len(str_Word) < 5
tst3 = scores(0, i) < 2
tst4 = hiQ(1) - scores(1, i) > 1 And _
Len(str_Word) - hiQ(1) < 4
w = Left$(sug(i), 1)
cons2 = Replace$(sug(i), "a", "")
cons2 = Replace$(cons2, "e", "")
cons2 = Replace$(cons2, "i", "")
cons2 = Replace$(cons2, "o", "")
cons2 = Replace$(cons2, "u", "")
If InStr("aeiou", w) > 0 Then cons2 = w & cons2
If (tst1 And tst2 And tst3) Or _
tst4 Or _
Abs(Len(str_Word) - Len(w3)) > 2 _
Then
If LCase$(cons) <> LCase$(cons2) And k > 3 Then
sug(i) = "zzzz"
End If
End If
ElseIf i < .ListCount And _
str_Word <> Replace$(sug(i), "-", "") And _
str_Word <> Replace$(sug(i), "'", "") _
Then
sug(i) = "zzzz"
Else
Stop
End If
End If
Next
End If
.Clear
j = 0
Do
If sug(j) <> "zzzz" Then .AddItem sug(j)
j = j + 1
Loop While sug(j) <> "" Or j < n
Do While .List(0) = "" And .ListCount > 0
.RemoveItem 0
Loop
If .ListCount > 0 Then
lev = 999
n = 0
Do
w3 = .List(n)
.RemoveItem n
If (Abs(Len(str_Word) - Len(w3)) < 4 Or _
InStr(w3, " ") > 0) And _
Left$(w3, 2) <> " P" _
Then
If InStr(w3, " ") > 0 And Left$(w3, 1) > "9" Then
' Split up a run-on word. '
' Make it go after after '
' non-split words with 1. '
.AddItem "2 - " & w3
n = n + 1
Else
If str_Word = w3 Then
l = 0
Else
l = LevDist(str_Word, w3)
End If
If (l < 3 Or (l = 3 And Len(str_Word) > 5)) And w3 <> " " Then
FindWordID w3 ' sets long_WordID '
FindWordIDEntry w3, long_WordID ' sets long_CortexID '
If long_CortexID = 0 Then
w3 = w3 & " (Not in Cortex.)"
'Stop
End If
.AddItem l & " - " & w3
n = n + 1
If l < lev Then lev = l
End If
End If
End If
Loop While n < .ListCount
End If
End With
WikiList:
' Look in Wikipedia's list of common misspellings: '
With WikiSpellRS
.Index = "Wrong"
.Seek "=", str_Word
If Not .NoMatch Then
Do
w3 = !Right
lstSuggestions.AddItem "0 - " & w3 & " (WikiSpell table)", 0
.MoveNext
Loop While !Wrong = w3
End If
End With
With WordsRS
If Len(str_Word) > 5 And Val(lstSuggestions.List(0)) > 1 Then
w2 = Left$(str_Word, 3)
.Seek ">=", w2
If Not .NoMatch Then
Do
i = LevDist(str_Word, !Text)
If i < 3 And InStr(!Text, " ") = 0 Then ' arbitrary '
lstSuggestions.AddItem i & " - " & !Text
End If
.MoveNext
If .EOF Then Exit Do
Loop While w2 = Left$(LCase$(!Text), 3)
' Remove duplicates: '
i = 0
Do While i < lstSuggestions.ListCount - 1
Do While Replace$(lstSuggestions.List(i), _
" (Not in Cortex.)", "") = _
Replace$(lstSuggestions.List(i + 1), _
" (Not in Cortex.)", "")
lstSuggestions.RemoveItem i
Loop
i = i + 1
Loop
End If
End If
End With
n = lstSuggestions.ListCount - 1
sug(0) = ""
With WordsRS 'WordFreqRS
WordsRS.Index = "Text"
For i = 0 To n
sug(i) = lstSuggestions.List(i)
j = Val(sug(i))
w3 = Mid$(sug(i), 5)
z = InStr(w3, " (")
If z > 0 Or Left$(w3, 1) = "0" Then
s = Mid$(w3, z)
w3 = Left$(w3, z - 1)
Else
s = ""
End If
If InStr(w3, " ") = 0 Then
.Seek "=", w3
If Not WordsRS.NoMatch Then
If WordsRS!Text <> w3 Then WordsRS.MoveNext
k = WordsRS!Text <> w3
Else
k = 0
End If
If WordsRS.NoMatch Or k Or IsNull(WordsRS!FreqUsed) Then
sug(i) = j & " (z) - " & w3
ElseIf WordsRS!FreqUsed < "4" Or str_Word = w3 Then
sug(i) = j & " (" & WordsRS!FreqUsed & ") - " & w3
Else
sug(i) = ""
End If
If sug(i) <> "" Then sug(i) = sug(i) & s
Else
' Run-on word splits: '
sug(i) = j & " (s) - " & w3
'Words = Split(w3)
'Stop
End If
Next
End With
With lstSuggestions
.Clear
k = Val(sug(0))
For i = 0 To n
If sug(i) <> "" Then
If InStr(sug(i), "- =") > 0 Then
sug(i) = "0.0.0 (0) - " & Mid$(sug(i), 11)
z = 0
ElseIf Len(cons) > 2 Then
j = InStr(sug(i), "-")
cons2 = Mid$(sug(i), j + 2)
s = Left$(cons2, 1)
j = InStr(cons2, "(")
If j > 0 Then cons2 = Left$(cons2, j - 2)
q2 = Abs(Len(cons2) - Len(t_Word))
cons2 = Replace$(cons2, "a", "")
If Right$(cons2, 2) = "gn" Then
cons2 = Left$(cons2, Len(cons2) - 2) & "n"
End If
cons2 = Replace$(cons2, "e", "")
cons2 = Replace$(cons2, "i", "")
cons2 = Replace$(cons2, "o", "")
cons2 = Replace$(cons2, "u", "")
If InStr("aeiou", s) > 0 Then cons2 = s & cons2
z = LevDist(cons2, cons)
sug(i) = Left$(sug(i), 1) & "." & z & "." & q2 & Mid$(sug(i), 2)
Else
sug(i) = Left$(sug(i), 1) & ".0.0" & Mid$(sug(i), 2)
End If
If z < 10 Then
.AddItem sug(i)
End If
End If
Next
If .ListCount = 2 Then
If originalSndx = "" Then
originalSndx = sndx
If Right$(sndx, 1) = "0" Then
sndx = ChopRight(sndx, 1) & "1"
Else
sndx = ChopRight(sndx, 1) & "0"
End If
GoTo CheckSndx
Else
.AddItem " - No suggestions found."
Exit Sub
End If
End If
For i = 2 To .ListCount - 1
w3 = .List(i)
w3 = Replace$(w3, "(z", "(_")
.List(i) = w3
Next
End With
End Sub
Upvote
0
@JogiDroid,
Yes, you have different possibilities.
They are in the Core Library under Keywords.
The Core Library Help
The B4A Help Viewer
AGrahams B4A XML file help viewer
Best regards.
Yes, you have different possibilities.
They are in the Core Library under Keywords.
The Core Library Help
The B4A Help Viewer
AGrahams B4A XML file help viewer
Best regards.
Last edited:
Upvote
0
I had already searched these sources for GOTO before asking on here, and didn't find anything. Can you be a little more specific about where I can find the alternative -- or you could just tell me...
Thanks.
Upvote
0
Yeah, i'd love to know an equivalent for 'goto' and even 'gosub' (for my old apple days).
However, does Basic4Android support functions?
Mike
However, does Basic4Android support functions?
Mike
Upvote
0
Yes. All subs can return values in Basic4android.
Please start with the tutorials listed here: Basic4android - Android programming with Gui designer
Upvote
0
There isn't an alternative to Goto, you will need to structure your code appropriately. Hopefully a Gosub equivalent will be available in a future release.
Upvote
0
@nfordbscndrd,
My post #5 was an answer to JogiDroid's post (#3) not to yours (#4), I modified it to clarify.
I had a look at your subroutine, it's a quite long one.
Now I understand why you won't like to restructure the sub.
I hope for you that there will be a Goto equivalent in B4A in the furure, otherwise unfortunately, I could just say good luck for restructuring the routines.
Best regards.
My post #5 was an answer to JogiDroid's post (#3) not to yours (#4), I modified it to clarify.
I had a look at your subroutine, it's a quite long one.
Now I understand why you won't like to restructure the sub.
I hope for you that there will be a Goto equivalent in B4A in the furure, otherwise unfortunately, I could just say good luck for restructuring the routines.
Best regards.
Upvote
0
I know that a sub can return a value, but that has nothing to do with the question of having the GOTO and GOSUB function *within* a sub.
When I'm deep into the middle of some complex code and need to get out of it and into another section of the code, sometimes from a lot of different places, I need to be able to say something like "GOTO SomePlace" where "SomePlace:" is a line label elsewhere in the same Sub.
In the code below, "GOTO AbortSave" is used in 15 different places. There simply isn't any easy way to structure the code to avoid using the GOTO's.
The code below is a large Sub which has a GOSUB in it. I know it's too big to really make sense of, but the gist is that the main part of the Sub is about 300 lines of code and the 2nd part (starting with the line label "ProcessEntry:") is 200 lines and a lot of the same variables are used in both parts.
It is not feasible to call a separate Sub for the 200 lines because so many variables would have to be passed to it from the original (300-line) Sub. By using GOSUB, I can put the second subroutine in the same Sub as the first one and use the same variables without having to pass their values.
The alternative to using GOSUB is that in B4A, I will have to enter the 200 lines of code twice (in this case, perhaps many times in other cases), once for each variable that I am processing.
B4X:
If Val(t_NewCID) = Val(cmbo_MultiStartID) And Val(t_NewCID) > 0 Then
MsgBox "StartID # is the same as the entry's ID#."
Exit Sub
ElseIf Val(cmbo_MultiStartID) = Val(t_Next) And Val(t_Next) > 0 Then
MsgBox "StartID # is the same as the NextID #."
Exit Sub
End If
If cmbo_MultiStartID.Text <> "" Then
If cmbo_MultiStartID.Text <> cmbo_MultiStartID.List(cmbo_MultiStartID.ListCount - 1) Then
cmbo_MultiStartID.AddItem cmbo_MultiStartID.Text
cmbo_MultiStartID.Height = 660
fr_POS.Top = cmbo_MultiStartID.Top + cmbo_MultiStartID.Height
End If
cmbo_MultiStartID.Text = ""
ElseIf Val(cmbo_NewLink) = 30930 Then ' contraction '
MsgBox "Enter the first word of the contraction in the Start field" & Chr$(13) & "and the second word, if any, in the Next field."
Exit Sub
End If
field = Trim$(cmbo_NewLink.Text)
If field = "" Then
s = "Enter a Link for the entry."
cmbo_NewLink.SetFocus
GoTo AbortSave
End If
If Val(field) = 0 Then
cmbo_NewLink_LostFocus
field = cmbo_NewLink
If Val(field) = 0 Then
s = "LinkID not found."
cmbo_NewLink.SetFocus
GoTo AbortSave
End If
End If
lID = Val(cmbo_NewLink)
If lID = 0 Then cmbo_NewLink_LostFocus ' Get LinkID# for LinkType text '
With CortexRS
''''''''''''''
If b_SaveNewEntry.Caption = "Sa&ve Changes" Then
' Check changed existing entry: '
If Trim$(t_NewCID) = "" Then
s = "The entry's ID# is missing."
t_NewCID.SetFocus
GoTo AbortSave
End If
.Index = "ID"
.Seek "=", Val(t_NewCID)
If .NoMatch Then
s = "Entry's cID# not found in database."
t_NewCID.SetFocus
GoTo AbortSave
End If
If cmbo_MultiStartID.ListCount > 1 Then
MsgBox "Save aborted:" & Chr$(13) & _
"When changing an existing entry, only one StartID is allowed."
cmbo_MultiStartID.SetFocus
GoTo AbortSave
End If
i = MsgBox("Save changes to this existing entry?", vbYesNo)
If i = vbNo Then
GoTo AbortSave
End If
End If
If t_NewWord <> "" Then
wID = Val(t_NewWord)
If wID = 0 Then
' SaveWord will check for existing '
' entry for the word before saving.'
SaveWord t_NewWord, cncl, wID
If cncl Then GoTo AbortSave
t_NewWord = wID & ": " & t_NewWord
Else
WordsRS.Index = "ID"
WordsRS.Seek "=", wID
If WordsRS.NoMatch Then
s = "No entry in the Words table was found for ID#" & wID
GoTo AbortSave
End If
If t_NewWord <> wID & ": " & WordsRS!Text Then
t_NewWord = wID & ": " & WordsRS!Text
End If
End If
Else
wID = 0
End If
' NextID -- '
t_Next = Trim$(t_Next)
If t_Next <> "" Then
txt = t_Next
If Left$(txt, 1) = "#" Then
i = InStr(txt, "=")
txt = LTrim$(Mid$(txt, i + 2))
End If
If Val(txt) > 2147483647 Then
s = "Number is too large for Next ID field."
If lID < 10 Then s = s & Chr$(13) & "Use LinkID# 10 for large numbers." & Chr$(13)
GoTo AbortSave
End If
id = Val(txt)
field = "NextID"
startOrNextPOS = Val(cmbo_POS(1))
GoSub ProcessEntry
If lID < 10 Then
If Val(t_Next) < 1 Then
s = "No numeric data entered in Next field for numeric Link." & Chr$(13)
GoTo AbortSave
End If
nID = Val(t_Next)
ElseIf lID > 999 Then
nID = Val(t_Next)
ElseIf lID > 9 Then
nID = Val(Mid$(t_Next, 2))
End If
End If
' StartID -- '
field = "StartID"
startOrNextPOS = Val(cmbo_POS(0))
If cmbo_MultiStartID.ListCount > 0 Then
For x = 0 To cmbo_MultiStartID.ListCount - 1
id = Val(cmbo_MultiStartID.List(x))
txt = cmbo_MultiStartID.List(x)
cmbo_MultiStartID.Text = txt
GoSub ProcessEntry
sID = Val(cmbo_MultiStartID.Text)
If b_SaveNewEntry.Caption = "Save &New Entry" Then
If wID > 0 Then
If t_NewWord = "" Then
wID = 0
Else
WordsRS.Index = "ID"
WordsRS.Seek "=", wID
If WordsRS.NoMatch Then
s = "WordID# " & wID & " is not in the Words table."
GoTo AbortSave
End If
End If
End If
If wID > 0 Then
.Index = "WordID2LinkID"
.Seek "=", wID, lID
Else
.Index = "StartID2NextID2LinkID"
If nID = 0 And t_Next <> "0" Then
.Seek "=", sID, Null, lID
ElseIf nID > 0 Then
.Seek "=", sID, nID, lID
If .NoMatch And lID > 999 Then
' If a Number table reference. Don't '
' need to check the fields reversed. '
.Seek "=", nID, sID, lID
End If
End If
End If
If Not .NoMatch Then
If sID = Val("" & !startID) And nID = Val("" & !nextID) Then
If Val("" & !linkID) > 0 Then
If InStr(t_NewPhrase, "<") > 0 Then
' Saving a script, so just enter the ID#: '
t_NewCID = "" & !id
Exit Sub
ElseIf cmbo_MultiStartID.ListCount = 1 Then
MsgBox "Save aborted:" & Chr$(13) & _
"This entry has already been saved (Cortex entry ID#" & !id & ")."
txt = cmbo_MultiStartID
cmbo_MultiStartID.Clear
cmbo_MultiStartID = txt
cmbo_MultiStartID.Height = 600
fr_POS.Top = 3330
Exit Sub
Else
MsgBox "The entry with the StartID shown has already been saved " & _
"(#" & !id & ")." & Chr$(13) & _
"Continuing with other StartID#'s."
GoTo SkipIt
End If
Else
cID = !id
End If
End If
End If
End If
' Save it: '
wID = Val(t_NewWord)
SaveNewEntry cID, wID, sID, nID, lID, cncl
If cncl Then Exit Sub
SkipIt:
Next
Else ' Nothing in StartID: '
sID = 0
SaveNewEntry cID, wID, sID, nID, lID, cncl
If cncl Then Exit Sub
End If
If wID > 0 Then ' And lID > 29999 And lID < 31000 Then
SaveSylsAndPrn cID, wID
If bln_Abort Then
bln_Abort = False
Exit Sub
End If
WordsRS.Index = "ID"
WordsRS.Seek "=", wID
i = Val("" & WordsRS!FreqUsed)
If i <> cmbo_Freq(1).ListIndex Or IsNull(WordsRS!FreqUsed) Then
WordsRS.Edit
If cmbo_Freq(1) <> "" Then
WordsRS!FreqUsed = cmbo_Freq(1).ListIndex
End If
WordsRS!Tag = ""
WordsRS.Update
End If
End If
txt = cmbo_MultiStartID
cmbo_MultiStartID.Clear
cmbo_MultiStartID = txt
cmbo_MultiStartID.Height = 600
fr_POS.Top = 3530
b_FindCID_Click
i = Val(cmbo_NewLink.Text)
If i = 30010 Then
b_Affix.Caption = "&Make entry for: noun plural"
ElseIf i >= 30050 And i <= 30065 Then
b_Affix.Caption = "&Make entry for: past tense"
ElseIf i = 30070 Then
b_Affix.Caption = "&Make entry for: gerund"
ElseIf i = 30080 Then
b_Affix.Caption = "&Make entry for: -s (verb)"
ElseIf i = 30090 Then
b_Affix.Caption = "&Make entry for: compar.adj."
ElseIf i = 30091 Then
b_Affix.Caption = "&Make entry for: superl.adj."
ElseIf i = 30092 Then
b_Affix.Caption = "&Make entry for: adverb"
End If
If b_Affix.Caption <> "" Then b_Affix.Visible = True
' Redisplay word: '
lb_Links.Clear
If lb_TypeOf.ListCount > 0 Then
lb_TypeOf_DblClick
ElseIf lb_POS.ListCount > 0 Then
lb_POS_DblClick
Else
w1 = cmbo_MultiStartID
i = InStr(w1, " - ")
If i > 0 Then w1 = Mid$(w1, i + 3)
w2 = t_Next
i = InStr(w2, " - ")
If i > 0 Then w2 = Mid$(w2, i + 3)
wd = t_NewWord
i = InStr(wd, ": ")
If i > 0 Then wd = Mid$(wd, i + 2)
If t_Word <> wd And t_Word <> w1 And t_Word <> w2 Then
If t_Word = "" Then
If wd <> "" Then
t_Word = wd
Else
t_Word = w1
End If
Else
Stop
End If
End If
b_LookItUp_Click
End If
Exit Sub
ProcessEntry:
''''''''''''
If id > 0 Or txt = "0" Or Left$(txt, 3) = "0, " Then ' Cortex ID# given. '
If lID < 1000 And field = "NextID" Then
If lID < 10 Then ' NextID is a numeric datum. '
nID = id
ElseIf lID = 900 Then ' NextID is the Shapes table. '
Stop
Else ' NextID is a link to the Numbers table. '
SaveNewNumData lID, id, txt, cncl
If cncl Then GoTo AbortSave
If id = 0 Then Stop ' entry # is not in database '
t_Next = "#" & id & " = " & t_Next
End If
ElseIf InStr(cmbo_MultiStartID.Text, "-word phrase") > 0 Then
cmbo_MultiStartID.Text = "" & Val(cmbo_MultiStartID.Text)
Return
Else
.Index = "ID"
.Seek "=", id
If .NoMatch Then
MsgBox txt & "#" & id & " is not in the Cortex."
If field = "NextID" Then
t_Next.SetFocus
Else
cmbo_MultiStartID.SetFocus
End If
Exit Sub
End If
End If
ElseIf txt <> "" And Left$(txt & " ", 1) <> "#" Then
' # not entered; look up text: '
If Left$(txt, 3) = "0 -" Then txt = Mid$(txt, 5)
FindWordID txt
If long_WordID = 0 Then
If InStr(txt, " ") > 0 Then
MsgBox "For multi-word terms, enter the ID#" & Chr$(13) & "of the entry joining the words."
Exit Sub
End If
y = MsgBox("'" & txt & "' is not in the Words table. Enter it?", vbYesNo)
If y = vbNo Then
If field = "NextID" Then
t_Next.SetFocus
Else
cmbo_MultiStartID.SetFocus
End If
Stop
Exit Sub
End If
SaveWord txt, cncl, wID2
If cncl Then Exit Sub
Else
wID2 = WordsRS!id
End If
' Look up Type-Of or Part-Of entry of StartID/NextID, if any: '
' First get WordID-POS entry: '
If startOrNextPOS = 0 Then
FindWordIDEntry txt, WordsRS!id
If long_CortexID = 0 Then
s = "POS entry not found for " & txt
GoTo AbortSave
End If
Cortex2RS.Index = "ID"
Cortex2RS.Seek "=", long_CortexID
startOrNextPOS = Cortex2RS!linkID
End If
Cortex2RS.Index = "WordID2LinkID"
Cortex2RS.Seek "=", wID2, startOrNextPOS
If Cortex2RS.NoMatch Then
s = "'" & txt & "' does not have a WordID-POS entry" & Chr$(13) & "with the POS shown." & Chr$(13) & "Make an entry for it first."
GoTo AbortSave
End If
i = Cortex2RS!id
Cortex3RS.Index = "StartID2LinkID"
' Now get type-of or part-of entry: '
Cortex3RS.Seek "=", i, lng_TypeOfID
If Cortex3RS.NoMatch Then Cortex3RS.Seek "=", i, lng_PartOfID
If Not Cortex3RS.NoMatch And _
Not Cortex2RS.NoMatch And _
lID <> lng_TypeOfID And _
lID <> lng_PartOfID _
Then
str_Phrase = ""
x = 0
' Build a list of sets this word belongs '
' to for the user to choose from: '
Do
If Cortex3RS!linkID = lng_TypeOfID Then
t = "type of"
Else
t = "part of"
End If
str_Phrase = str_Phrase & "cID# " & Cortex3RS!id & _
": " & t & " = " & Cortex3RS!nextID & Chr$(13)
id = Cortex3RS!nextID
bln_ShowDetail = False
LookUpLinks id, str_Phrase
bln_ShowDetail = ck_ShowDetail.Value
Cortex3RS.MoveNext
If Cortex3RS.EOF Then Exit Do
Loop While Cortex3RS!WordID = wID2 And Cortex3RS!linkID = lng_TypeOfID
Do
j = Val(InputBox$("Enter number of entry to use for " & _
txt & ":" & Chr$(13) & Chr$(13) & str_Phrase & Chr$(13) & _
"WordID-POS entry #" & Cortex2RS!id & " " & _
txt & " - " & Cortex2RS!linkID))
If j = 0 Then
s = "No entry number selected."
GoTo AbortSave
End If
Loop While InStr(str_Phrase & Cortex2RS!id, "" & j) = 0 ' Make sure # is one listed. '
Else
j = Cortex2RS!id
End If
If field = "StartID" Then
cmbo_MultiStartID = j & ": " & txt
Else
t_Next = j & ": " & txt
End If
End If
If id > 0 And lID > 999 And _
(lID < 30000 Or lID > 30899) And _
InStr(alreadyChecked, " " & id & " ") = 0 _
Then
.Index = "ID"
.Seek "=", id
alreadyChecked = alreadyChecked & " " & id & " "
j = !linkID
If j >= lng_FirstPOSID And j <= lng_LastPOSID Then ' Entry has a POS link. '
.Index = "StartID2LinkID"
.Seek "=", id, 29010
If .NoMatch Then .Seek "=", id, 29110
If Not .NoMatch Then n = "" & !id
s = ""
z = 0
Do While Not .NoMatch
If Val("" & !startID) <> i Or _
!linkID <> lng_TypeOfID _
Then
Exit Do
End If
z = z + 1
s = i & " - " & !nextID & Chr$(13)
.MoveNext
If .EOF Then Exit Do
Loop
If z > 0 Then
If z = 1 And _
n <> txt And _
Val("" & !startID) = id _
Then
y = MsgBox("The WordID-POS entered has a Type-Of entry." & Chr$(13) & _
"Use that entry instead?", vbYesNoCancel)
If y = vbYes Then
If field = "StartID" Then
cmbo_MultiStartID.Text = txt
Else
t_Next = txt
End If
ElseIf y = vbCancel Then
Exit Sub
End If
ElseIf z > 1 Then
j = InputBox("The WordID-POS entered has these Type-Of entries:" & _
Chr$(13) & s & Chr$(13) & _
"Enter the ID# of the entry to use or press Enter" & Chr$(13) & _
"to use the original entry ID# you entered:")
If j > 0 Then
y = InStr(s, j & " ")
If y > 0 Then
z = InStr(y + 4, s, Chr$(13))
If field = "StartID" Then
cmbo_MultiStartID.Text = Mid$(s, y, z - y)
Else
t_Next = Mid$(s, y, z - y)
End If
End If
End If
End If
End If
End If
End If
Return
End With
AbortSave:
'''''''''
MsgBox "Save aborted." & Chr$(13) & s
bln_Abort = True
Upvote
0
Below is a list I have started working on...
Edit: A revised list has been posted in a message below.
Last edited:
Upvote
0
I wonder if you can use functions along with if then/else/while commands in place of goto and gosub. I believe this is possible - I think.
Mike
Mike
Upvote
0
Nice!!! This is TOTALLY useful. Please address files, as I will DEFINITELY be using them (lol). I will add to this if I get good enough at B4A.
Mike
Upvote
0
I changed up Mid$(text, n, x) to clarify it and added Left$ and Right$:
B4X:
Mid$(text, n, x) [x=length wanted] text.SubString2(n, n+x) [n+x=end position]
Ex: Mid$("abcd", 2, 2) = "bc" "abcd".SubString2(2, 2+2) = "bc" [pos. 2-4]
Left$(text, n) [n=num.of chars.] text.SubString2(1, n)
Ex: Left$("abcd", 2) = "ab" "abcd".SubString2(1, 2) = "ab" [position 1-2]
Right$(text, n) text.SubString(text.Length - n + 1)
Ex: Right$("abcd", 2) = "cd" "abcd".SubString(4 - 2 + 1) = "cd" [position 3+]
Upvote
0
In your samples above you are incorrect on "abcd".SubString2(1, 2) = "ab"
It would only return the "b". The string is zero based: "abcd".SubString2(0, 2) = "ab"
Upvote
0
I went back to Core - String and it doesn't mention that the first character in the string is considered character 0. You can get it from studying the example, but I just wasn't thinking along those lines because I've never seen string pointers treated this way before, so I didn't notice it. Maybe they should add a note mentioning it.
Apparently, B4A treats a string as an array of characters where the first character in the string is array element 0.
Mid$("abcde", 1, 1) = "a" = letter array index 0
Mid$("abcde", 2, 1) = "b" = letter array index 1
Mid$("abcde", 3, 1) = "c" = letter array index 2
Mid$("abcde", 4, 1) = "d" = letter array index 3
Mid$("abcde", 5, 1) = "e" = letter array index 4
In "abcde".SubString2(n, x), "n" is an array index 0-4 (the "BeginIndex") and "x" is an array index 0-5 ("EndIndex") because the SubString only goes up to but not including the letter array element specified by the EndIndex, so to get last actual letter of the string, you have to use an index one greater than the actual last letter array index.
As you can see, the BeginIndex is just 1 less than the character position you want to start with, while the EndIndex is the same actual position of the character you want to end with. However, in VB, we don't specify a start and end character position, we specify a start position and length, so to get the ending character position, you have to add the length to the start position MINUS 1. Example: Mid$("abcde", 2, 3) = "bcd", but the ending character position of "d" is actually 4, which is 2+3-1.
To convert Mid$("abcde", 2, 3) to B4A, referring back to the chart above, "bcd" have indices 1-3, so BeginIndex = 1 and EndIndex is 4, as shown in the last example. So in B4A, you have "abcde".SubString2(1, 4), or:
Mid$(text, n, x) = text.SubString2(n-1, n+x-1)
For Left$("abcde", 2), you use SubString2 and you want the letters with indices 0 and 1, which is "abcde".SubString2(0, 1+2-1). Notice that 1+2-1=2, so the EndIndex when converting Left$ is the same as the character position used in Left$, or ...
Left$(text, n) = text.SubString2(0, n)
For Right$("abcde", 2), you want the letters with indices 3 and 4, which is "abcde".SubString(3, 5). The BeginIndex is the length of the string (which is 5) minus the number in Right$ (which is 2) plus 1. You have to use 5 (the length of the string) as the EndIndex even though there is no letter for index 5 because the SubString does not include the character with the EndIndex. So ...
Right$(text, n) = text.SubString2(text.Length - n + 1, text.Length)
An easier conversion to B4A is to use SubString rather than SubString2 because SubString just goes from BeginIndex to the end of the string:
Right$(text, n) = text.SubString(text.Length - n + 1)
So here are the revised equivalents for converting from VB to B4A:
B4X:
VB B4A
== ===
Mid$(text, n, x) [x=length wanted] text.SubString2(n-1, n+x-1) [n+x-1=end position]
Ex: Mid$("abcd", 2, 2) = "bc" "abcd".SubString2(1, 3) = "bc" [pos. 2-3]
0123 : index 1 up to but excluding index 3 = bc
Left$(text, n) [n=num.of chars.] text.SubString2(0, n)
Ex: Left$("abcd", 2) = "ab" "abcd".SubString2(0, 2) = "ab" [position 1-2]
Right$(text, n) text.SubString(text.Length - n + 1)
Ex: Right$("abcd", 2) = "cd" "abcd".SubString(4 - 2 + 1) = "cd" [position 3+]If you think this is confusing, welllll, it took me over 2 hours to compose this message because I kept getting mixed up. (Hey, I'm OLD!) Can't wait to start converting a few thousand lines of code now.
Upvote
0
I just noticed that these:
Mid$(text, n, 1) text.CharAt(n)
Mid$(text, n) text.SubString(n)
should have been changed to
Mid$(text, n, 1) text.CharAt(n - 1)
Mid$(text, n) text.SubString(n - 1)
Mid$(text, n, 1) text.CharAt(n)
Mid$(text, n) text.SubString(n)
should have been changed to
Mid$(text, n, 1) text.CharAt(n - 1)
Mid$(text, n) text.SubString(n - 1)
Upvote
0
I think this thread should be a sticky or start a new thread with this list - OP, please make one of these a sticky!
Could you please keep the list updated so we can copy and paste it with all corrections in place?
Thank you for doing this.
Mike
Could you please keep the list updated so we can copy and paste it with all corrections in place?
Thank you for doing this.
Mike
Upvote
0
Similar Threads
