Hi Pete,
Well, I got it to compile, more or less, but no idea if it is going to do anything like you want. Based on my simple approach.
I took your vb code, loaded as is into Paul's fbeditor. Got a load of compile message, of course, but went through picking out those that gave conflicts, based on the fb help file. I got rid of the variable suffixes, defined them at beginning of function. Used a temp string, instead of referring to the function name within the function, and removed some of the string concats (&). The bit I didn't do was to get the call to the testnum subroutine. I think I'd leave it within the function, and use go to's instead of gosubs (I did, but never sorted the 'return'), perhaps use a temp value to know where you came from, and return to where you need based on that value. Not at all elegant, but once it works, tidy it up as required. Obviously, there is a number of more elegant solutions, but I'm no expert. Anyway, guess you've sorted it by now.
Not sure if I helped,
But Best wishes,
Ray
I don't seem to be able to get the codes for inserting code, so have fun with the following
code.......
dim a as String
declare function code128(chaine as string) as string
a= code128(a)
Function code128(chaine as string) as string
'Cette fonction est régie par la Licence Générale Publique Amoindrie GNU (GNU LGPL)
'This function is governed by the GNU Lesser General Public License (GNU LGPL)
'V 2.0.0
'Paramètres : une chaine
'Parameters : a string
'Retour : * une chaine qui, affichée avec la police CODE128.TTF, donne le code barre
' * une chaine vide si paramètre fourni incorrect
'Return : * a string which give the bar code when it is dispayed with CODE128.TTF font
' * an empty string if the supplied parameter is no good
Dim i as integer, checksum as integer
dim mini as integer, dummy as integer, tableB As Boolean
dim temp as string
temp=""
code128 = ""
If Len(chaine) > 0 Then
'Vérifier si caractères valides
'Check for valid characters
For i = 1 To Len(chaine)
Select Case Asc(Mid(chaine, i, 1))
Case 32 To 126, 203
Case Else
i = 0
Exit For
End Select
Next
'Calculer la chaine de code en optimisant l'usage des tables B et C
'Calculation of the code string with optimized use of tables B and C
temp=""
'code128 = ""
tableB = True
If i > 0 Then
i = 1 'i% devient l'index sur la chaine / i% become the string index
Do While i <= Len(chaine)
If tableB Then
'Voir si intéressant de passer en table C / See if interesting to switch to table C
'Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres / yes for 4 digits at start or end, else if 6 digits
mini = IIf(i = 1 Or i + 3 = Len(chaine), 4, 6)
Goto testnum
If mini < 0 Then
If i = 1 Then 'Débuter sur table C / Starting with table C
'code128 = Chr(210)
temp=chr(210)
Else 'Commuter sur table C / Switch to table C
temp= temp+ Chr(204) '*****
End If
tableB = False
Else
If i = 1 Then code128 = Chr(209) 'Débuter sur table B / Starting with table B
End If
End If
If Not tableB Then
'On est sur la table C, essayer de traiter 2 chiffres / We are on table C, try to process 2 digits
mini = 2
Goto testnum
If mini < 0 Then 'OK pour 2 chiffres, les traiter / OK for 2 digits, process it
dummy = Val(Mid(chaine, i, 2))
dummy = IIf(dummy < 95, dummy + 32, dummy + 105)
' code128 = code128 & Chr(dummy)
temp=temp+chr(dummy)
i = i + 2
Else 'On n'a pas 2 chiffres, repasser en table B / We haven't 2 digits, switch to table B
'code128 = code128 & Chr(205)
temp=temp+chr(205)
tableB = True
End If
End If
If tableB Then
'Traiter 1 caractère en table B / Process 1 digit with table B
'code128 = code128 & Mid$(chaine, i, 1)
temp=temp+mid(chaine,i,1)
i = i + 1
End If
Loop
'Calcul de la clé de contrôle / Calculation of the checksum
'For i = 1 To Len(code128)
for i=1 to len (temp )
'dummy = Asc(Mid$(code128, i, 1))
dummy=asc (mid(temp,i,1))
dummy = IIf(dummy < 127, dummy - 32, dummy - 105)
If i = 1 Then checksum = dummy
checksum = (checksum + (i - 1) * dummy) Mod 103
Next
'Calcul du code ASCII de la clé / Calculation of the checksum ASCII code
checksum = IIf(checksum < 95, checksum + 32, checksum + 105)
'Ajout de la clé et du STOP / Add the checksum and the STOP
'code128 = code128 & Chr(checksum) & Chr(211)
temp=temp &chr(checksum) & chr(211)
End If
End If
code128=temp
Exit Function
testnum:
'si les mini% caractères à partir de i% sont numériques, alors mini%=0
'if the mini% characters from i% are numeric, then mini%=0
mini = mini - 1
If i + mini <= Len(chaine) Then
Do While mini >= 0
If Asc(Mid(chaine, i + mini, 1)) < 48 Or Asc(Mid(chaine, i + mini, 1)) > 57 Then Exit Do
mini = mini - 1
Loop
End If
Return ' ***** needs sorting
code 128=temp
End Function
