Translate an old VB Module

[Petrus Vorster]

hi All

I have managed to get a better module for my EAN128 Barcodes.
It is in VB6
(and it works perfectly in VB6)

It looks simple enough, here and there i changed Boolean to BYTE and changed true and false to %true and %false.
There is something i am missing.

Is anyone here willing to take a look at the code? Its no more than 50 lines.
This is the unchanged code:

Code Select Expand

Public Function code128$(chaine$)
  '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%, checksum&, mini%, dummy%, tableB As Boolean
  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
    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)
          GoSub testnum
          If mini% < 0 Then 'Choix table C / Choice of table C
            If i% = 1 Then 'Débuter sur table C / Starting with table C
              code128$ = Chr$(210)
            Else 'Commuter sur table C / Switch to table C
              code128$ = code128$ & 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
          GoSub 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%)
            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)
            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)
          i% = i% + 1
        End If
      Loop
      'Calcul de la clé de contrôle / Calculation of the checksum
      For i% = 1 To Len(code128$)
        dummy% = Asc(Mid$(code128$, 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)
    End If
  End If
  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
End Function


I really want this barcodes to be right this time and not have one odd one here and there.
Will REALLY appreciate any help here.

-Pete

[raymw]

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

[Paul Squires]

Hi Ray, I am reading this post and I get the impression that Peter wants the code translated to PowerBasic code rather than FreeBasic (because he has already converted true/false to %true and %false)? I can certainly help do the FB conversion but I have no interest in converting to PB.

Peter, what conversion do you need?

[Petrus Vorster]

Firstly, you fellows are absolutely awesome for helping with this old stuff of mine.
For now, i need this to Powerbasic.

What is happening is that that if you want to produce EAN128 barcodes, then just about every module is for sale.
On the ENTIRE web, i could find two VB modules, each with it's own Barcode font.
Very similar, but the one i have has a distinctive flaw when your check digit ends on 0 it refers to an unlisted ASCII character in the font file.
(resulting in a barcode with some odd characters.)

The other one, as above resolves to different check digits, yet still all valid, but i just could not get it to work in PB. (thanks again RAYMW!!)

I made this SMS application in PB some time ago and since we mostly have systems from the days of NOAH, i have to make workarounds to what the company offers. (Some systems still run on XP)
This tool then prints a barcode sheet that the employee can just take it to a point and scan it, instead of dragging along a thousand parcels.
(it really works)

To re-do this in FB will be done eventually when your new Firefly is done. (i am regrettably a drag-and-drop "programmer") and we can work perhaps one day on Win10 on a decent work pc.

Thanks a million, i truly appreciate any guidance.

[raymw]

Hi Pete,
I didn't get the Power Basic requirement. If you can write power basic, maybe you have a compiler that will throw sensible? error messages, and use the same kludgy method that I did. But, the function is not that difficult to describe, and the comments seem pretty reasonable, so could probably be easier to start from scratch if you have access to power basic, that is. Mind you, I know nothing about power basic.

Best wishes,

Ray

[raymw]

fwiw, I thought I'd see if there was a free trial of power basic out there, thought i could hack something out for the bar codes. I knew it was sort of being de-emphasized, but all I came across was loads of dead links, and criticism of what may be the current owner, if there is one. I did come across a beautiful succinct post from Jose, of this parish, with reference to marriage (on oxygen basic forum).
Maybe, Pete, you could get a job for life at your place, rewriting everything into your current language of choice.

[Paul Squires]

Hi Peter, I did the conversion (as best that I could). I don't have any test data to try the function with so I have no idea if it works or not.

Code Select Expand


' EAN128 Barcodes
' Translation of VB6 code to PowerBASIC
' https://www.planetsquires.com/protect/forum/index.php?topic=4250.msg32700#msg32700

' The GS1-128 is a special form of the Code 128. It's used for goods and palettes
' in commerce and industry. The name GS1-128 replaces the old name EAN/UCC 128.

Function code128( ByVal chaine As String ) As String
   ' This feature is regulated by the GNU Lesser General Public License (GNU LGPL)
   ' V 2.0.0
   ' Parameters: a chain
   ' Parameters: a string
   ' Back: * a string that, displayed with the CODE128.TTF font, gives the barcode
   ' * An empty string if parameter supplied 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 Long, checksum As Long, mini As Long, dummy As Long, true As Long, false As Long
   Dim tableB As Long ' Boolean
   Dim sResult As String
   
   true = -1
   false = Not true
   
   If Len(chaine) > 0 Then
      ' 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

      ' Calculation of the code string with optimized use of tables B and C
      tableB = True
      If i > 0 Then
         i = 1   ' i become the string index
         Do While i <= Len(chaine)
            If tableB Then
               ' See if interesting to switch to table C
               ' yes for 4 digits at start or end, else if 6 digits
               mini = IIf(i = 1 Or i + 3 = Len(chaine), 4, 6)
               GoSub testnum
               If mini < 0 Then ' Choice of table C
                  If i = 1 Then  ' Starting with table C
                     sResult = Chr$(210)
                  Else ' Switch to table C
                     sResult = sResult & Chr$(204)
                  End If
                  tableB = False
               Else
                  If i = 1 Then sResult = Chr$(209) ' Starting with table B
               End If
            End If
   
            If Not tableB Then
               ' We are on table C, try to process 2 digits
               mini = 2
               GoSub testnum
               If mini < 0 Then ' OK for 2 digits, process it
                  dummy = Val(Mid$(chaine, i, 2))
                  dummy = IIf(dummy < 95, dummy + 32, dummy + 105)
                  sResult = sResult & Chr$(dummy)
                  i = i + 2
               Else ' We haven't 2 digits, switch to table B
                  sResult = sResult & Chr$(205)
                  tableB = True
               End If
            End If
            If tableB Then
               ' Process 1 digit with table B
               sResult = sResult & Mid$(chaine, i, 1)
               i = i + 1
            End If
         Loop
   
         ' Calculation of the checksum
         For i = 1 To Len(sResult)
            dummy = Asc(Mid$(sResult, i, 1))
            dummy = IIf(dummy < 127, dummy - 32, dummy - 105)
            If i = 1 Then checksum = dummy
            checksum = (checksum + (i - 1) * dummy) Mod 103
         Next
         ' Calculation of the checksum ASCII code
         checksum = IIf(checksum < 95, checksum + 32, checksum + 105)
         ' Add the checksum and the STOP
         sResult = sResult & Chr$(checksum) & Chr$(211)
      End If
   
   End If
   
   Function = sResult

Exit Function

testnum:
   ' 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

End Function


Function PBMain()

' (01)01234567890128(15)051231
' 010123456789012815051231
   Dim chaine As String
   chaine = "(01)01234567890128(15)051231"

   MsgBox code128( chaine )

End Function


[Petrus Vorster]

Thanks a million guys.
I am on the road this week for work, once i am back, I will compile in PB and see if i can make any progress.
Otherwise for now, i have changed to font CODE39 which is dead simple, but makes LONG barcodes.

That was why i asked about .NET earlier. VB.NEt as a ONE LINE code for creating an EAN128 Barcode.

I am so going to hit the bed now....

Thanks for everything.

-Regards Pete