VB Function to return CODE128b barcode font string (SOLVED)

guyborchers · Feb 26, 2007

I found what looks to be a BASIC or perhaps early C form of code that will do exactly this, however I am finding it out of my grasp to 'convert' the below code over to VB for Excel, and I was hoping someone would be able to piece it together for me

.

Code128B is a barcode font that requires a 'computed' start and end bit, as well as a checksum character(s) in order for the barcode to be valid and readable by barcode scanners.

This code (in whatever it is written, I don't really know), is said to do just that.

Code:

************************************************
* Purpose - demonstrates the function CODE128b.
* CALLS - CODE128b
* There are three barcode formats A, B and C. Function CODE128b returns format "B" only.
* Barcode 128 requires a start code, string (barcode value), checksum value and stop code.
* Acceptable string values are between ascii 32 - 126
* Function CODE128b will strip out any other values.
* Your program will require a Barcode 128 truetype font
*
LOCAL lcTeststring
DIMENSION a_code( 2 )

*************************************
* test values, good, illegal chars and empty
* rem unrem as needed
lcteststring = 'This is a test string.'
* lcTestString = 'This is a ' + CHR(133) + CHR(155) + 'tes' + CHR( 116 ) + CHR(32) + 'string.'
* lcteststring = ''

a_code( 1 ) = lcteststring
code128b( @a_code )

***************************************
* do case to demonstrate result
DO case
CASE a_code( 2 ) > 0
	lcmessage = ALLTRIM( STR( a_code( 2 ) ) ) + ' characters were removed.' + CHR(13) + ;
		'String conversion - ' + a_code( 1 )
CASE a_code( 2 ) = -1
	lcmessage = 'Empty value passed'
OTHERWISE
	lcmessage = 'String conversion - ' + a_code( 1 )
ENDCASE

MESSAGEBOX( lcmessage, 48 )

*********************************
* call your report or label

RETURN

PROCEDURE code128b
*****************************************************
* Purpose  - convert a string to barcode 128 b
* REQUIRES - one dimenson array with two elements. Passed by reference
* PARAMETERS - a_result
* a_result( 1 ) - string, value to convert.
* a_result( 2 ) - init as logical, stores numeric.
* lnError - number of characters outside of ascii 32-126
* lnChksum - barcode128 checksum value
* lnX - pointer, character position for checksum calculation.
* lcString - a_resul( 1 ), initial string value
* lcCode - resulting barcode string
* RETURNS array a_result
* a_result( 1 ) - convertd string
* a_result( 2 ) - error status, -1 = empty, 0 = no error, 0 > number of characters removed

LPARAMETERS a_Result
LOCAL lnError, lnChksum, lnX, lcString, lcCode
STORE 0 TO lnChksum, lnError, lnX
STORE '' TO lcCode, lcString

lcString = IIF( VARTYPE( a_Result( 1 ) ) <> 'C', '', ALLTRIM( a_Result( 1 ) ) )
a_Result( 2 ) = IIF( EMPTY( lcString), -1, 0 )

FOR i = 1 TO LEN( lcString )

	IF !BETWEEN( ASC( SUBSTR( lcString, i, 1 )  ), 32, 126 )	&& illegal char
		lnError = lnError + 1	&& increment error counter
		LOOP
	ENDIF
	lnx = lnx + 1 	&& increment char pointer
	*************************************
	* calculate checksum, ( ASCII value - 32 ) times the char position
	* minus 32 is the offset between the ASCII value and the char value from TABLE B of BARCODE 128
	lnChksum = lnChksum + ( ( ASC( SUBSTR( lcString, i, 1 ) ) - 32 )* lnX )
	*************************************
	* build the correct string without illegal chars
	lcCode = lcCode + SUBSTR( lcString, i, 1 )
	
ENDFOR

****************************
* set error result if errors
a_Result( 2 ) = IIF( a_Result( 2 ) = -1, -1, lnError )

****************************
* Checksum is the Modulus from
* wieghted chars values ( barcode128b value * char position )
* Plus startcode value ( 104 )
* devided by 103
lnChksum = lnChksum + 104
lnChksum = MOD( lnChksum, 103 )

*****************************
* final string is startcode + string + cheksum + stopcode
a_Result( 1 ) = CHR( 204 ) + lcCode + CHR( lnChksum + 32 ) + CHR( 206 )

RETURN

Thanks to anyone who puts time towards this,

~Guy

*edit: changed topic

Norie · Feb 26, 2007

Guy

Could you post some sample data and expected results?

I think that'll be easier to help with than trying to deconstruct the code and translate it to VBA.

PS As far as I can find out that's code for Visual Foxpro.

guyborchers · Feb 28, 2007

using an example I had found in JavaScript apparently written for ID Automation's implimentation of Code128, I converted that script (which did not allow for 'condensing 2 numerical digits in a row' to one digit) and also added functionality to condense 2 numerical digits in a row into one digit.

It took a bit of time to figure out how the checksum was being derived whenever there was a 'condensed' numerical digit, as well as when it went from 'condensed' mode to 'text mode'.... but here is the result:

A function that will create a Code128B barcode using the Code128bWin.ttf font Created by Brian Dobson (http://www.dobsonsw.com)

tried to make an internal 'switch' on the program that would output the encoded string in ID Automation's format, but it is untested, as I don't have that font.

Please let me know what you think!

Thanks,

PS. I found an isInt() function with search on these forums, and it is required for the Code128b() function to work at this time.

Rich (BB code):

Function isInt(toCheck As Variant) As Boolean
Dim temp As Integer
On Error GoTo err
temp = CInt(toCheck) 'trys to set the given variable to an integer
isInt = True 'if suceeds then return true
Exit Function
err:
isInt = False 'else return false
End Function

Function Code128b(ByVal rawData) As String
' Function Code128b, returns encoded code128b string (with checkbit)
' default functionality returns string with start and stop bits expected by
' the Code128bWin.ttf font Created by Brian Dobson (http://www.dobsonsw.com)

' provided a 'switch' to allow for apparent characters expected by ID Automations (as well
' as perhaps others') implimentation of Code128B
'
' This function currently has an export limit of 999 characters

    Dim offset, highAscii, total, character, asciivalue, checkdigit
    Dim check, holder, version, startChar, encodeNum, checkCounter
    Dim tstartChar, nstartChar, EndChar, ntChar, tnChar, spaceChar
    Dim encodedString
    Dim previousEncoding ' 0=text 1=numeric
    
    offset = 32
    highAscii = 18
    total = 104 ' initiates checksum total calculator
    
    version = 0  ' set this identifier to '1' for ID automation's version (i hope)
    
    If version = 0 Then ' www.dobsonsw.com's Version
       tstartChar = "š"
       nstartChar = "›"
       EndChar = "œ"
       ntChar = "–"
       tnChar = "•"
       spaceChar = "€"
    ElseIf version = 1 Then 'ID Automation's (and others?) version
       tstartChar = "Ì"
       nstartChar = "Í"
       EndChar = "Î"
       ntChar = "É"
       tnChar = "È" ' I'm guessing at this character, because I have not found an explicit example of this case yet atm
       spaceChar = "€" ' I'm guessing at this character too
    'elseif version = 2 then ' placeholder for 'future' start/stop/seguey characters
       'tstartChar = ""
       'nstartChar = ""
       'EndChar = ""
       'ntChar = ""
       'tnChar = ""
       'spaceChar =""
    End If
      
    For stringCounter = 1 To Len(rawData)
       checkCounter = checkCounter + 1
       'Determine the startCharacter
       If stringCounter = 1 Then
          If isInt(Mid(rawData, stringCounter, 1)) Then
             If isInt(Mid(rawData, stringCounter + 1, 1)) Then
                startChar = nstartChar
                previousEncoding = 1
                total = total + 1
             Else
                startChar = tstartChar
             End If
          Else
             startChar = tstartChar
          End If
       End If
              
       If isInt(Mid(rawData, stringCounter, 1)) Then
          If isInt(Mid(rawData, stringCounter + 1, 1)) Then
             If previousEncoding = 0 Then
                encodedString = encodedString & tnChar
                previousEncoding = 1
                total = total + (((Asc(tnChar) - offset - highAscii)) * checkCounter)
                checkCounter = checkCounter + 1
             End If
             encodeNum = Mid(rawData, stringCounter, 1) & Mid(rawData, stringCounter + 1, 1)
             
             If offset + encodeNum >= 127 Then
                 character = Chr(offset + encodeNum + highAscii)
             Else
                 character = Chr(offset + encodeNum)
             End If
             asciivalue = offset + encodeNum
             stringCounter = stringCounter + 1
             'don't forget to grab the checkbit information for the 'skipped' character
             checkdigit = ((asciivalue - offset) * (checkCounter))
          Else
             If previousEncoding = 1 Then
                encodedString = encodedString & ntChar
                previousEncoding = 0
                total = total + (((Asc(ntChar) - offset - highAscii)) * checkCounter)
                checkCounter = checkCounter + 1
             End If
             character = Mid(rawData, stringCounter, 1)
             asciivalue = Asc(character)
             checkdigit = ((asciivalue - offset) * (checkCounter))
          End If
       Else
          If previousEncoding = 1 Then
             encodedString = encodedString & ntChar
             previousEncoding = 0
             total = total + (((Asc(ntChar) - offset - highAscii)) * checkCounter)
             checkCounter = checkCounter + 1
          End If
          character = Mid(rawData, stringCounter, 1)
          asciivalue = Asc(character)
          checkdigit = ((asciivalue - offset) * (checkCounter))
       End If
          
       ' Replaces any ' ' characters (space) with '€' Characters
       ' I'm not 1000% sure whether this is the character ID Automation's Font uses either...
       If Asc(character) = 32 Then
           character = spaceChar
       End If
       
       encodedString = encodedString & character
       total = total + checkdigit 'adds checkdigit data to running total
    
    Next stringCounter
    
    
   
   ''' Creates 'checksum character'
    check = total Mod 103
    If (check + offset) >= 127 Then
        holder = check + offset + highAscii
    Else
        holder = check + offset
    End If

    If Chr(holder) <> " " Then
       checkdigit = Chr(holder)
    Else
       checkdigit = spaceChar
    End If
   
    ' Returns barcode string
    Code128b = startChar & encodedString & checkdigit & EndChar
    
End Function

*Edits:
** March 13th, 2007
Bugfix: Forgot to watch out for pesky space character on the
checkdigit! Bugfix is edited into code above

guyborchers · Mar 13, 2007

Edited post above with fix to code,... had previously forgotten to check for that asc(32) character (space) on the checkdigit...

which, albeit rarely, would produce a barcode that was unreadable / incorrect...

find:

Code:

checkdigit = Chr(holder)

replace with

Code:

    If Chr(holder) <> " " Then
       checkdigit = Chr(holder)
    Else
       checkdigit = spaceChar
    End If

Norie · Mar 13, 2007

Guy

Glad to see you solved the problem and thanks for posting the solution.

Only sorry we couldn't help you out.

dfgwere · Jan 21, 2013

Has anyone used this Java Code 128 barcode generator SDK with guide?

VB Function to return CODE128b barcode font string (SOLVED)

guyborchers

Board Regular

Excel Facts

Norie

Well-known Member

guyborchers

Board Regular

guyborchers

Board Regular

Norie

Well-known Member

dfgwere

New Member

Similar threads

Forum statistics

Share this page

VB Function to return CODE128b barcode font string (SOLVED)

guyborchers

Board Regular

Excel Facts

Norie

Well-known Member

guyborchers

Board Regular

guyborchers

Board Regular

Norie

Well-known Member

dfgwere

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock