* FoxPro encoder functions for UPC/EAN/JAN barcodes
* Copyright by MW6 Technologies Inc. All rights reserved.
*
* This code may not be modified or distributed unless you purchase
* the license from MW6.

* Rename this file to MW6UEJ.PRG, add MW6UEJ.PRG to your VFP project,
* put the following command in VFP code:
*    SET PROCEDURE TO MW6UEJ.PRG ADDITIVE
*
* Sample code
*     private res
*     res = UPCA("12345678901")
*     res = UPCE("123456")
*     res = EAN13("123456789012")
*     res = EAN8("1234567")
*     res = JAN13("491234567890")
*     res = JAN8("4912345")


Function GetCheckDigit
	parameters Src

	private I, StrLen CheckSum

	StrLen = Len(Src)
	CheckSum = 0
	For I = 1 To StrLen
		If Mod(I, 2) = 1 Then
			CheckSum = CheckSum + (Asc(SubStr(Src, StrLen - I + 1, 1)) - Asc("0")) * 3
		Else
			CheckSum = CheckSum + Asc(SubStr(Src, StrLen - I + 1, 1)) - Asc("0")
		EndIf
	Next I

	CheckSum = Mod(CheckSum, 10)
	If CheckSum <> 0 Then
		CheckSum = 10 - CheckSum
	EndIf

	return CheckSum
EndFunc

Function EAN13
	parameters Src

	private I, tmpData, OneCh, StrLen, CharSet, EncodedMessage, CheckSum, FirstCh

	tmpData = Src
	StrLen = Len(Src)

	* make sure tmpData has 12 characters
	If (StrLen < 12) Then
		Do While (Len(tmpData) < 12)
			tmpData = tmpData + "0"
		EndDo While
	Else
		If (StrLen > 12) Then
			tmpData = Left(tmpData, 12)
		EndIf
	EndIf

	* choose character set depending on the first character of string
	FirstCh = (Asc(SubStr(tmpData, 1, 1)) - Asc("0"))
	Do Case
		Case FirstCh = 0 
			CharSet = "AAAAAA"
		Case FirstCh = 1 
			CharSet = "AABABB"
		Case FirstCh = 2
			CharSet = "AABBAB"
		Case FirstCh = 3
			CharSet = "AABBBA"
		Case FirstCh = 4
			CharSet = "ABAABB"
		Case FirstCh = 5
			CharSet = "ABBAAB"
		Case FirstCh = 6 
			CharSet = "ABBBAA"
		Case FirstCh =7
			CharSet = "ABABAB"
		Case FirstCh = 8
			CharSet = "ABABBA"
		Case FirstCh = 9
			CharSet = "ABBABA"
	EndCase

	EncodedMessage = Chr(Asc(SubStr(tmpData, 1, 1)) - Asc("0") + 192) + "("
	For I = 2 To 7
		oneCh = SubStr(CharSet, I - 1, 1)
		If OneCh = "A" Then
			EncodedMessage = EncodedMessage + SubStr(tmpData, I, 1)
		Else
			EncodedMessage = EncodedMessage + Chr(Asc(SubStr(tmpData, I, 1)) - Asc("0") + Asc("Q"))
		EndIf
	Next I

	EncodedMessage = EncodedMessage + "*"
	For I = 8 To 12
		EncodedMessage = EncodedMessage + Chr(Asc(SubStr(tmpData, I, 1)) - Asc("0") + Asc("A"))
	Next I

	EncodedMessage = EncodedMessage + Chr(GetCheckDigit(tmpData) + Asc("A"))
	EncodedMessage = EncodedMessage + ")"

	return EncodedMessage
EndFunc

Function EAN8
	parameters Src

	private I, tmpData, OneCh, StrLen, CharSet, EncodedMessage, CheckSum, FirstCh

	StrLen = Len(Src)
	tmpData = Src

	* make sure tmpData has 7 characters
	If (StrLen < 7) Then
		Do While (Len(tmpData) < 7)
			tmpData = tmpData + "0"
		EndDo While
	Else
		If (StrLen > 7) Then
			tmpData = Left(tmpData, 7)
		EndIf
	EndIf

	EncodedMessage = "("

	For I = 1 To 4
		EncodedMessage = EncodedMessage + SubStr(tmpData, I, 1)
	Next I

	EncodedMessage = EncodedMessage + "*"
	For I = 5 To 7
		EncodedMessage = EncodedMessage + Chr(Asc(SubStr(tmpData, I, 1)) - Asc("0") + Asc("A"))
	Next I

	EncodedMessage = EncodedMessage + Chr(GetCheckDigit(tmpData) + Asc("A"))
	EncodedMessage = EncodedMessage + ")"

	return EncodedMessage
EndFunc

Function JAN13
	parameters Src

	* The first 2 digits must be "49" for JAN13
	If (Not (SubStr(Src, 1, 2) = "49")) Then
		return ""
	Else
		return EAN13(Src)
	End If
EndFunc

Function JAN8
	parameters Src

	* The first 2 digits must be "49" for JAN8
	If (Not (SubStr(Src, 1, 2) = "49")) Then
		return ""
	Else
		return EAN8(Src)
	End If
    
EndFunc

Function UPCA
	parameters Src

	private I, tmpData, OneCh, StrLen, CharSet, EncodedMessage, CheckSum, FirstCh

	StrLen = Len(Src)
	tmpData = Src

	* make sure tmpData has 11 characters
	If (StrLen < 11) Then
		Do While (Len(tmpData) < 11)
			tmpData = tmpData + "0"
		EndDo While
	Else
		If (StrLen > 11) Then
			tmpData = Left(tmpData, 11)
		EndIf
	EndIf

	EncodedMessage = Chr(Asc(SubStr(tmpData, 1, 1)) - Asc("0") + 192) + "("
	EncodedMessage = EncodedMessage + Chr(Asc(SubStr(tmpData, 1, 1)) - Asc("0") + Asc("a"))
	 
	For I = 2 To 6
		EncodedMessage = EncodedMessage + SubStr(tmpData, I, 1)
	Next I

	EncodedMessage = EncodedMessage + "*"
	For I = 7 To 11
		EncodedMessage = EncodedMessage + Chr(Asc(SubStr(tmpData, I, 1)) - Asc("0") + Asc("A"))
	Next I

	CheckDigit = GetCheckDigit(tmpData)
	EncodedMessage = EncodedMessage + Chr(CheckDigit + Asc("q"))
	EncodedMessage = EncodedMessage + ")" + Chr(CheckDigit + 192)

	return EncodedMessage
EndFunc

Function UPCE
	parameters Src

	private I, tmpData, OneCh, StrLen, CharSet, EncodedMessage, CheckSum, FirstCh

	StrLen = Len(Src)
	tmpData = Src

	* make sure tmpData has 6 characters
	If (StrLen < 6) Then
		Do While (Len(tmpData) < 6)
			tmpData = tmpData + "0"
		EndDo While
	Else
		If (StrLen > 6) Then
			tmpData = Left(tmpData, 6)
		EndIf
	EndIf

	tmpData = "0" + tmpData

	* choose character set depending on the check digit value
	CheckDigit = GetCheckDigit(UPCE2UPCA(tmpData))
	Do Case 
		Case CheckDigit = 0
			CharSet = "BBBAAA"
		Case CheckDigit = 1
			CharSet = "BBABAA"
		Case CheckDigit = 2
			CharSet = "BBAABA"
		Case CheckDigit = 3
			CharSet = "BBAAAB"
		Case CheckDigit = 4
			CharSet = "BABBAA"
		Case CheckDigit = 5
			CharSet = "BAABBA"
		Case CheckDigit = 6
			CharSet = "BAAABB"
		Case CheckDigit = 7
			CharSet = "BABABA"
		Case CheckDigit = 8
			CharSet = "BABAAB"
		Case CheckDigit = 9
			CharSet = "BAABAB"
	EndCase

	EncodedMessage = Chr(192) + "("
	For I = 2 To 7
		tmp = SubStr(CharSet, I - 1, 1)
		If tmp = "A" Then
			EncodedMessage = EncodedMessage + SubStr(tmpData, I, 1)
		Else
			EncodedMessage = EncodedMessage + Chr(Asc(SubStr(tmpData, I, 1)) - Asc("0") + Asc("Q"))
		EndIf
	Next I
	EncodedMessage = EncodedMessage + "+" + Chr(CheckDigit + 192)

	return EncodedMessage
EndFunc

Function UPCE2UPCA
	parameters Src

	private OneCh

	OneCh = SubStr(Src, 7, 1)
	Do Case
		Case OneCh = "0"
			return SubStr(Src, 1, 3) + SubStr(Src, 7, 1) + "0000" + SubStr(Src, 4, 3)
		Case OneCh = "1"
			return SubStr(Src, 1, 3) + SubStr(Src, 7, 1) + "0000" + SubStr(Src, 4, 3)
		Case OneCh = "2"
			return SubStr(Src, 1, 3) + SubStr(Src, 7, 1) + "0000" + SubStr(Src, 4, 3)
		Case OneCh =  "3"
			return SubStr(Src, 1, 4) + "00000" + SubStr(Src, 5, 2)
		Case OneCh = "4"
			return SubStr(Src, 1, 5) + "00000" + SubStr(Src, 6, 1)
		Case OneCh = "5"
			return SubStr(Src, 1, 6) + "0000" + SubStr(Src, 7, 1)
		Case OneCh = "6"
			return SubStr(Src, 1, 6) + "0000" + SubStr(Src, 7, 1)
		Case OneCh = "7"
			return SubStr(Src, 1, 6) + "0000" + SubStr(Src, 7, 1)
		Case OneCh = "8"
			return SubStr(Src, 1, 6) + "0000" + SubStr(Src, 7, 1)
		Case OneCh = "9"
			return SubStr(Src, 1, 6) + "0000" + SubStr(Src, 7, 1)
	EndCase
EndFunc