BarCode (code2of5,code11,code128,code39,code93,EAN8/13,...)

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

BarCode (code2of5,code11,code128,code39,code93,EAN8/13,...)

Message par GallyHC »

Bonjour,

J'ai repris un code-source provenant du forum anglais réalisé par "TeddyLM" pour la création de codes-à-barres. J'ai corrigé un Bug sur le code-128 (erreur Checksum, modulo 103 et donc faut pouvoir encodé 103 caractères) et j'en ai ajouté d'autres. Maintenant je vous le partage. Cela donne :

Image
A vous d'en faire bon usage.

Code : Tout sélectionner

; CODE ORIGINAL : TeddyLM
; https://www.purebasic.fr/english/viewtopic.php?p=533663#p533663

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

DisableASM
CompilerIf Not #PB_Compiler_EnableExplicit
  EnableExplicit
CompilerEndIf

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

Enumeration
  #BARCODE_2of5
  #BARCODE_11
  #BARCODE_39
  #BARCODE_93
  #BARCODE_128
  #BARCODE_EAN_8
  #BARCODE_EAN_13
  #BARCODE_EAN_128
  #BARCODE_POSTNET
  #BARCODE_PDF417
  #BARCODE_QR_CODE
  #BARCODE_DATAMATRIX
EndEnumeration

Enumeration
  #TEXT_NONE
  #TEXT_CENTER
  #TEXT_CENTER_IN
  #TEXT_EAN
  #TEXT_EAN_TITLE
  #TEXT_UCPA
EndEnumeration

Global DISPLAYTEXT.s
Global BARWIDTH.i     = 2

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

Procedure.s Get_BarcodePostNet(text.s)
  
  Define.l counter
  Define.s char, result = ""
  
  DISPLAYTEXT = text
  If text <> #Null$
    Define.l checksum = 0
    For counter = 1 To Len(text)
      checksum + Val(Mid(text, counter, 1))
    Next counter
    text + Str((10 - (checksum % 10)) % 10)    
    ;
    result + "b1,s1,"
    For counter = 1 To Len(text)
      Select Mid(text, counter, 1)
        Case "0"    : result + "b1,s1,b1,s1,c1,s1,c1,s1,c1,s1,"
        Case "1"    : result + "c1,s1,c1,s1,c1,s1,b1,s1,b1,s1,"
        Case "2"    : result + "c1,s1,c1,s1,b1,s1,c1,s1,b1,s1,"
        Case "3"    : result + "c1,s1,c1,s1,b1,s1,b1,s1,c1,s1,"
        Case "4"    : result + "c1,s1,b1,s1,c1,s1,c1,s1,b1,s1,"
        Case "5"    : result + "c1,s1,b1,s1,c1,s1,b1,s1,c1,s1,"
        Case "6"    : result + "c1,s1,b1,s1,b1,s1,c1,s1,c1,s1,"
        Case "7"    : result + "b1,s1,c1,s1,c1,s1,c1,s1,b1,s1,"
        Case "8"    : result + "b1,s1,c1,s1,c1,s1,b1,s1,c1,s1,"
        Case "9"    : result + "b1,s1,c1,s1,b1,s1,c1,s1,c1,s1,"
      EndSelect
    Next counter    
    result + ",b1,"
  EndIf
  ProcedureReturn result
  
EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

Procedure.s Get_Barcode2of5(text.s)
  
  Define.l counter, Loop
  Define.s char1, char2
  Define.s result= "", result1 = "", result2 = ""
  DISPLAYTEXT = text

  If text <> #Null$
    If Len(text) & 1 
      text = "0" + text 
    EndIf
    result = "b1,s1,b1,s1,"
    For counter = 1 To Len(text) Step 2
      result1 = ""
      result2 = ""
      char1 = Mid(text, counter,     1)
      char2 = Mid(text, counter + 1, 1)
      Select char1
        Case "0" : result1 + "nnWWn"       
        Case "1" : result1 + "WnnnW"
        Case "2" : result1 + "nWnnW"
        Case "3" : result1 + "WWnnn"
        Case "4" : result1 + "nnWnW"
        Case "5" : result1 + "WnWnn"
        Case "6" : result1 + "nWWnn"
        Case "7" : result1 + "nnnWW"
        Case "8" : result1 + "WnnWn"
        Case "9" : result1 + "nWnWn"
      EndSelect
      result2 = ""
      Select char2
        Case "0" : result2 + "nnWWn"
        Case "1" : result2 + "WnnnW"
        Case "2" : result2 + "nWnnW"
        Case "3" : result2 + "WWnnn"
        Case "4" : result2 + "nnWnW"
        Case "5" : result2 + "WnWnn"
        Case "6" : result2 + "nWWnn"
        Case "7" : result2 + "nnnWW"
        Case "8" : result2 + "WnnWn"
        Case "9" : result2 + "nWnWn"
      EndSelect
      For Loop = 1 To 5
        Select Mid(result1, loop, 1)
          Case "n" : result + ",b1"
          Case "W" : result + ",b3"
        EndSelect
        Select Mid(result2, loop, 1)
          Case "n" : result + ",s1"
          Case "W" : result + ",s3"
        EndSelect
      Next
    Next
    result + ",b2,s1,b1,"
  EndIf
  ProcedureReturn result

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

Procedure.s Get_Barcode11(text.s)
  
  Define.l counter
  Define.s char, sgap, interchar = ",s1", result = ""
  
  DISPLAYTEXT = text
  If text <> #Null$
 	  Define.i weightC    = 0
	  Define.i weightK    = 1
	  Define.i weightSumC = 0
	  Define.i weightSumK = 0
	  For counter = Len(text) To 1 Step -1
	    weightC = (weightC + 1) % 11
      weightK = (weightK + 1) % 10
	    If weightC = 0 : weightC = 1 : EndIf
	    If weightK = 0 : weightK = 1 : EndIf
	    Select Mid(text, counter, 1)
	      Case "-"
	        weightSumC + (weightC * 10)
	        weightSumK + (weightK * 10)
	      Default
	        weightSumC + (weightC * Val(Mid(text, counter, 1)))
	        weightSumK + (weightK * Val(Mid(text, counter, 1)))
	    EndSelect
	  Next counter
    weightSumK + weightSumC % 11
    Define.i c = weightSumC % 11
    Define.i k = weightSumK % 11
    If c = 10 : text + "-" : Else : text + Str(c) : EndIf
    If Len(text) > 9
      If k = 10 : text + "-" : Else : text + Str(k) : EndIf
    EndIf
	  ;
    result = "b1,s1,b2,s2,b1" + interchar
    For counter=1 To Len(text)
      Select Mid(text, counter, 1)
        Case "0"  : result + ",b1,s1,b1,s1,b2" + interchar
        Case "1"  : result + ",b2,s1,b1,s1,b2" + interchar
        Case "2"  : result + ",b1,s2,b1,s1,b2" + interchar
        Case "3"  : result + ",b2,s2,b1,s1,b1" + interchar
        Case "4"  : result + ",b1,s1,b2,s1,b2" + interchar
        Case "5"  : result + ",b2,s1,b2,s1,b1" + interchar
        Case "6"  : result + ",b1,s2,b2,s1,b1" + interchar
        Case "7"  : result + ",b1,s1,b1,s2,b2" + interchar
        Case "8"  : result + ",b2,s1,b1,s2,b1" + interchar
        Case "9"  : result + ",b2,s1,b1,s1,b1" + interchar
        Case "-"  : result + ",b1,s1,b2,s1,b1" + interchar
      EndSelect
    Next counter
    result + ",b1,s1,b2,s2,b1,"
  EndIf
  ProcedureReturn result
  
EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

Procedure.s Get_Barcode39(text.s)
  
  Define.l counter
  Define.s char, sgap, result = ""
  
  DISPLAYTEXT = UCase(text)
  If text <> #Null$
    text = UCase(text)
    result = "b1,s3,b1,s1,b3,s1,b3,s1,b1"
    sgap = ",s1,"
    For counter = 1 To Len(text)
      char = Mid(text, counter, 1)
      Select char
        Case "0" : result + sgap + "b1,s1,b1,s3,b3,s1,b3,s1,b1"
        Case "1" : result + sgap + "b3,s1,b1,s3,b1,s1,b1,s1,b3"
        Case "2" : result + sgap + "b1,s1,b3,s3,b1,s1,b1,s1,b3"
        Case "3" : result + sgap + "b3,s1,b3,s3,b1,s1,b1,s1,b1"       
        Case "4" : result + sgap + "b1,s1,b1,s3,b3,s1,b1,s1,b3"
        Case "5" : result + sgap + "b3,s1,b1,s3,b3,s1,b1,s1,b1"
        Case "6" : result + sgap + "b1,s1,b3,s3,b3,s1,b1,s1,b1"
        Case "7" : result + sgap + "b1,s1,b1,s3,b1,s1,b3,s1,b3"
        Case "8" : result + sgap + "b3,s1,b1,s3,b1,s1,b3,s1,b1"
        Case "9" : result + sgap + "b1,s1,b3,s3,b1,s1,b3,s1,b1"       
        Case "A" : result + sgap + "b3,s1,b1,s1,b1,s3,b1,s1,b3"       
        Case "B" : result + sgap + "b1,s1,b3,s1,b1,s3,b1,s1,b3"       
        Case "C" : result + sgap + "b3,s1,b3,s1,b1,s3,b1,s1,b1"       
        Case "D" : result + sgap + "b1,s1,b1,s1,b3,s3,b1,s1,b3"       
        Case "E" : result + sgap + "b3,s1,b1,s1,b3,s3,b1,s1,b1"       
        Case "F" : result + sgap + "b1,s1,b3,s1,b3,s3,b1,s1,b1"       
        Case "G" : result + sgap + "b1,s1,b1,s1,b1,s3,b3,s1,b3"       
        Case "H" : result + sgap + "b3,s1,b1,s1,b1,s3,b3,s1,b1"       
        Case "I" : result + sgap + "b1,s1,b3,s1,b1,s3,b3,s1,b1"       
        Case "J" : result + sgap + "b1,s1,b1,s1,b3,s3,b3,s1,b1"       
        Case "K" : result + sgap + "b3,s1,b1,s1,b1,s1,b1,s3,b3"       
        Case "L" : result + sgap + "b1,s1,b3,s1,b1,s1,b1,s3,b3"       
        Case "M" : result + sgap + "b3,s1,b3,s1,b1,s1,b1,s3,b1"      
        Case "N" : result + sgap + "b1,s1,b1,s1,b3,s1,b1,s3,b3"       
        Case "O" : result + sgap + "b3,s1,b1,s1,b3,s1,b1,s3,b1"       
        Case "P" : result + sgap + "b1,s1,b3,s1,b3,s1,b1,s3,b1"       
        Case "Q" : result + sgap + "b1,s1,b1,s1,b1,s1,b3,s3,b3"       
        Case "R" : result + sgap + "b3,s1,b1,s1,b1,s1,b3,s3,b1"       
        Case "S" : result + sgap + "b1,s1,b3,s1,b1,s1,b3,s3,b1"       
        Case "T" : result + sgap + "b1,s1,b1,s1,b3,s1,b3,s3,b1"       
        Case "U" : result + sgap + "b3,s3,b1,s1,b1,s1,b1,s1,b3"       
        Case "V" : result + sgap + "b1,s3,b3,s1,b1,s1,b1,s1,b3"       
        Case "W" : result + sgap + "b3,s3,b3,s1,b1,s1,b1,s1,b1"   
        Case "X" : result + sgap + "b1,s3,b1,s1,b3,s1,b1,s1,b3"           
        Case "Y" : result + sgap + "b3,s3,b1,s1,b3,s1,b1,s1,b1"           
        Case "Z" : result + sgap + "b1,s3,b3,s1,b3,s1,b1,s1,b1"   
        Case "-" : result + sgap + "b1,s3,b1,s1,b1,s1,b3,s1,b3"
        Case "." : result + sgap + "b3,s3,b1,s1,b1,s1,b3,s1,b1"
        Case " " : result + sgap + "b1,s3,b3,s1,b1,s1,b3,s1,b1"
        Case "$" : result + sgap + "b1,s3,b1,s3,b1,s3,b1,s1,b1"
        Case "/" : result + sgap + "b1,s3,b1,s3,b1,s1,b1,s3,b1"
        Case "+" : result + sgap + "b1,s3,b1,s1,b1,s3,b1,s3,b1"
        Case "%" : result + sgap + "b1,s1,b1,s3,b1,s3,b1,s3,b1"
      EndSelect
    Next
    result + sgap + "b1,s3,b1,s1,b3,s1,b3,s1,b1" + sgap
  EndIf
  ProcedureReturn result
    
EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

Procedure.s Get_Barcode93(text.s)
  
  Define.l counter, value, weight
  Define.s char, reverse, result = ""
  DISPLAYTEXT = UCase(text)
    
  If text <> #Null$
    text      = UCase(text)
    reverse   = ReverseString(text)
    result    = "b1,s1,b1,s1,b1,b1,b1,b1,s1"
    value     = 0
    weight    = 1
    For counter = 1 To Len(reverse)
      char = Mid(reverse, counter, 1)
      Select char                                     
        Case "0" : value + (0  * Weight)
        Case "1" : value + (1  * Weight)
        Case "2" : value + (2  * Weight)
        Case "3" : value + (3  * Weight)
        Case "4" : value + (4  * Weight)
        Case "5" : value + (5  * Weight)
        Case "6" : value + (6  * Weight)
        Case "7" : value + (7  * Weight)
        Case "8" : value + (8  * Weight)
        Case "9" : value + (9  * Weight)
        Case "A" : value + (10 * Weight)
        Case "B" : value + (11 * Weight)
        Case "C" : value + (12 * Weight)
        Case "D" : value + (13 * Weight)
        Case "E" : value + (14 * Weight)
        Case "F" : value + (15 * Weight)
        Case "G" : value + (16 * Weight)
        Case "H" : value + (17 * Weight)
        Case "I" : value + (18 * Weight)
        Case "J" : value + (19 * Weight)
        Case "K" : value + (20 * Weight)
        Case "L" : value + (21 * Weight)
        Case "M" : value + (22 * Weight)
        Case "N" : value + (23 * Weight)
        Case "O" : value + (24 * Weight)
        Case "P" : value + (25 * Weight)
        Case "Q" : value + (26 * Weight)
        Case "R" : value + (27 * Weight)
        Case "S" : value + (28 * Weight)
        Case "T" : value + (29 * Weight)
        Case "U" : value + (30 * Weight)
        Case "V" : value + (31 * Weight)
        Case "W" : value + (32 * Weight)
        Case "X" : value + (33 * Weight)
        Case "Y" : value + (34 * Weight)
        Case "Z" : value + (35 * Weight)
        Case "-" : value + (36 * Weight)
        Case "." : value + (37 * Weight)
        Case " " : value + (38 * Weight)
        Case "$" : value + (39 * Weight)
        Case "/" : value + (40 * Weight)
        Case "+" : value + (41 * Weight)
        Case "%" : value + (42 * Weight)
      EndSelect
      weight = weight + 1 
      If weight = 21 
        weight = 1 
      EndIf
    Next       
    Define.i checksum = Mod(value, 47)
    Define.s checksumC = StringField("0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,-,., ,$,/,+,%", checksum + 1, ",") 
    reverse = checksumC + reverse
    text = text + checksumC
    value = 0
    weight = 1
    For counter = 1 To Len(reverse)
      char = Mid(reverse, counter, 1)
      Select char
        Case "0" : value + (0  * Weight)
        Case "1" : value + (1  * Weight)
        Case "2" : value + (2  * Weight)
        Case "3" : value + (3  * Weight)
        Case "4" : value + (4  * Weight)
        Case "5" : value + (5  * Weight)
        Case "6" : value + (6  * Weight)
        Case "7" : value + (7  * Weight)
        Case "8" : value + (8  * Weight)
        Case "9" : value + (9  * Weight)
        Case "A" : value + (10 * Weight)
        Case "B" : value + (11 * Weight)
        Case "C" : value + (12 * Weight)
        Case "D" : value + (13 * Weight)
        Case "E" : value + (14 * Weight)
        Case "F" : value + (15 * Weight)
        Case "G" : value + (16 * Weight)
        Case "H" : value + (17 * Weight)
        Case "I" : value + (18 * Weight)
        Case "J" : value + (19 * Weight)
        Case "K" : value + (20 * Weight)
        Case "L" : value + (21 * Weight)
        Case "M" : value + (22 * Weight)
        Case "N" : value + (23 * Weight)
        Case "O" : value + (24 * Weight)
        Case "P" : value + (25 * Weight)
        Case "Q" : value + (26 * Weight)
        Case "R" : value + (27 * Weight)
        Case "S" : value + (28 * Weight)
        Case "T" : value + (29 * Weight)
        Case "U" : value + (30 * Weight)
        Case "V" : value + (31 * Weight)
        Case "W" : value + (32 * Weight)
        Case "X" : value + (33 * Weight)
        Case "Y" : value + (34 * Weight)
        Case "Z" : value + (35 * Weight)
        Case "-" : value + (36 * Weight)
        Case "." : value + (37 * Weight)
        Case " " : value + (38 * Weight)
        Case "$" : value + (39 * Weight)
        Case "/" : value + (40 * Weight)
        Case "+" : value + (41 * Weight)
        Case "%" : value + (42 * Weight)
      EndSelect
      weight = weight + 1 
      If weight = 16 
        weight = 1 
      EndIf
    Next       
    checksum = Mod(value, 47)
    checksumC = StringField("0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,-,., ,$,/,+,%", checksum+1, ",")
    text = text + checksumC
    For counter = 1 To Len(text)
      char = Mid(text, counter, 1)
      Select char
          Case "0" : result + ",b1,s3,b1,s1,b1,s2"
          Case "1" : result + ",b1,s1,b1,s2,b1,s3"
          Case "2" : result + ",b1,s1,b1,s3,b1,s2"
          Case "3" : result + ",b1,s1,b1,s4,b1,s1"
          Case "4" : result + ",b1,s2,b1,s1,b1,s3"
          Case "5" : result + ",b1,s2,b1,s2,b1,s2"
          Case "6" : result + ",b1,s2,b1,s3,b1,s1"
          Case "7" : result + ",b1,s1,b1,s1,b1,s4"
          Case "8" : result + ",b1,s3,b1,s2,b1,s1"
          Case "9" : result + ",b1,s4,b1,s1,b1,s1"
          Case "A" : result + ",b2,s1,b1,s1,b1,s3"
          Case "B" : result + ",b2,s1,b1,s2,b1,s2"
          Case "C" : result + ",b2,s1,b1,s3,b1,s1"
          Case "D" : result + ",b2,s2,b1,s1,b1,s2"
          Case "E" : result + ",b2,s2,b1,s2,b1,s1"
          Case "F" : result + ",b2,s3,b1,s1,b1,s1"
          Case "G" : result + ",b1,s1,b2,s1,b1,s3"
          Case "H" : result + ",b1,s1,b2,s2,b1,s2"
          Case "I" : result + ",b1,s1,b2,s3,b1,s1"
          Case "J" : result + ",b1,s2,b2,s1,b1,s2"
          Case "K" : result + ",b1,s3,b2,s1,b1,s1"
          Case "L" : result + ",b1,s1,b1,s1,b2,s3"
          Case "M" : result + ",b1,s1,b1,s2,b2,s2"
          Case "N" : result + ",b1,s1,b1,s3,b2,s1"
          Case "O" : result + ",b1,s2,b1,s1,b2,s2"
          Case "P" : result + ",b1,s3,b1,s1,b2,s1"
          Case "Q" : result + ",b2,s1,b2,s1,b1,s2"
          Case "R" : result + ",b2,s1,b2,s2,b1,s1"
          Case "S" : result + ",b2,s1,b1,s1,b2,s2"
          Case "T" : result + ",b2,s1,b1,s2,b2,s1"
          Case "U" : result + ",b2,s2,b1,s1,b2,s1"
          Case "V" : result + ",b2,s2,b2,s1,b1,s1"
          Case "W" : result + ",b1,s1,b2,s1,b2,s2"
          Case "X" : result + ",b1,s1,b2,s2,b2,s1"
          Case "Y" : result + ",b1,s2,b2,s1,b2,s1"
          Case "Z" : result + ",b1,s2,b3,s1,b1,s1"
          Case "-" : result + ",b1,s2,b1,s1,b3,s1"
          Case "." : result + ",b3,s1,b1,s1,b1,s2"
          Case " " : result + ",b3,s1,b1,s2,b1,s1"
          Case "$" : result + ",b3,s2,b1,s1,b1,s1"
          Case "/" : result + ",b1,s1,b2,s1,b3,s1"
          Case "+" : result + ",b1,s1,b3,s1,b2,s1"
          Case "%" : result + ",b2,s1,b1,s1,b3,s1" 
      EndSelect
    Next
    result + ",b1,s1,b1,s1,b1,b1,b1,b1,s1,b1,"
  EndIf
  ProcedureReturn result

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

Procedure.s Get_Barcode128(text.s)

  Define.l counter, value
  Define.s char, result = ""
  DISPLAYTEXT = text
  If text <> #Null$
    text = ReplaceString(text, "'", "`")
    value = 104
    For counter = 1 To Len(text)
      char = Mid(text, counter, 1)
      Select char
        Case " " :      value + (0  * counter)
        Case "!" :      value + (1  * counter)
        Case #DQUOTE$ : value + (2  * counter)
        Case "#" :      value + (3  * counter)
        Case "$" :      value + (4  * counter)
        Case "%" :      value + (5  * counter)
        Case "&" :      value + (6  * counter)
        Case "'" :      value + (7  * counter)
        Case "(" :      value + (8  * counter)
        Case ")" :      value + (9  * counter)
        Case "*" :      value + (10 * counter)
        Case "+" :      value + (11 * counter)
        Case "," :      value + (12 * counter)
        Case "-" :      value + (13 * counter)
        Case "." :      value + (14 * counter)
        Case "/" :      value + (15 * counter)
        Case "0" :      value + (16 * counter)
        Case "1" :      value + (17 * counter)
        Case "2" :      value + (18 * counter)
        Case "3" :      value + (19 * counter)
        Case "4" :      value + (20 * counter)
        Case "5" :      value + (21 * counter)
        Case "6" :      value + (22 * counter)
        Case "7" :      value + (23 * counter)
        Case "8" :      value + (24 * counter)
        Case "9" :      value + (25 * counter)
        Case ":" :      value + (26 * counter)
        Case ";" :      value + (27 * counter)
        Case "<" :      value + (28 * counter)
        Case "=" :      value + (29 * counter)
        Case ">" :      value + (30 * counter)
        Case "?" :      value + (31 * counter)
        Case "@" :      value + (32 * counter)
        Case "A" :      value + (33 * counter)
        Case "B" :      value + (34 * counter)
        Case "C" :      value + (35 * counter)
        Case "D" :      value + (36 * counter)
        Case "E" :      value + (37 * counter)
        Case "F" :      value + (38 * counter)
        Case "G" :      value + (39 * counter)
        Case "H" :      value + (40 * counter)
        Case "I" :      value + (41 * counter)
        Case "J" :      value + (42 * counter)
        Case "K" :      value + (43 * counter)
        Case "L" :      value + (44 * counter)
        Case "M" :      value + (45 * counter)
        Case "N" :      value + (46 * counter)
        Case "O" :      value + (47 * counter)
        Case "P" :      value + (48 * counter)
        Case "Q" :      value + (49 * counter)
        Case "R" :      value + (50 * counter)
        Case "S" :      value + (51 * counter)
        Case "T" :      value + (52 * counter)
        Case "U" :      value + (53 * counter)
        Case "V" :      value + (54 * counter)
        Case "W" :      value + (55 * counter)
        Case "X" :      value + (56 * counter)
        Case "Y" :      value + (57 * counter)
        Case "Z" :      value + (58 * counter)
        Case "[" :      value + (59 * counter)
        Case "\" :      value + (60 * counter)
        Case "]" :      value + (61 * counter)
        Case "^" :      value + (62 * counter)
        Case "_" :      value + (63 * counter)
        Case "`" :      value + (64 * counter)
        Case "a" :      value + (65 * counter)
        Case "b" :      value + (66 * counter)
        Case "c" :      value + (67 * counter)
        Case "d" :      value + (68 * counter)
        Case "e" :      value + (69 * counter)
        Case "f" :      value + (70 * counter)
        Case "g" :      value + (71 * counter)
        Case "h" :      value + (72 * counter)
        Case "i" :      value + (73 * counter)
        Case "j" :      value + (74 * counter)
        Case "k" :      value + (75 * counter)
        Case "l" :      value + (76 * counter)
        Case "m" :      value + (77 * counter)
        Case "n" :      value + (78 * counter)
        Case "o" :      value + (79 * counter)
        Case "p" :      value + (80 * counter)
        Case "q" :      value + (81 * counter)
        Case "r" :      value + (82 * counter)
        Case "s" :      value + (83 * counter)
        Case "t" :      value + (84 * counter)
        Case "u" :      value + (85 * counter)
        Case "v" :      value + (86 * counter)
        Case "w" :      value + (87 * counter)
        Case "x" :      value + (88 * counter)
        Case "y" :      value + (89 * counter)
        Case "z" :      value + (90 * counter)
        Case "{" :      value + (91 * counter)
        Case "|" :      value + (92 * counter)
        Case "}" :      value + (93 * counter)
        Case "~" :      value + (94 * counter)
        Default
          ProcedureReturn
      EndSelect
    Next
    Define.i checksum = Mod(value, 103) 
    Select checksum
      Case 0    : text + " "
      Case 1    : text + "!"
      Case 2    : text + #DQUOTE$
      Case 3    : text + "#"
      Case 4    : text + "$"
      Case 5    : text + "%"
      Case 6    : text + "&"
      Case 7    : text + "'"
      Case 8    : text + "("
      Case 9    : text + ")"
      Case 10   : text + "*"
      Case 11   : text + "+"
      Case 12   : text + ","
      Case 13   : text + "-"
      Case 14   : text + "."
      Case 15   : text + "/"
      Case 16   : text + "0"
      Case 17   : text + "1"
      Case 18   : text + "2"
      Case 19   : text + "3"
      Case 20   : text + "4"
      Case 21   : text + "5"
      Case 22   : text + "6"
      Case 23   : text + "7"
      Case 24   : text + "8"
      Case 25   : text + "9"
      Case 26   : text + ":"
      Case 27   : text + ";"
      Case 28   : text + "<"
      Case 29   : text + "="
      Case 30   : text + ">"
      Case 31   : text + "?"
      Case 32   : text + "@"
      Case 33   : text + "A"
      Case 34   : text + "B"
      Case 35   : text + "C"
      Case 36   : text + "D"
      Case 37   : text + "E"
      Case 38   : text + "F"
      Case 39   : text + "G"
      Case 40   : text + "H"
      Case 41   : text + "I"
      Case 42   : text + "J"
      Case 43   : text + "K"
      Case 44   : text + "L"
      Case 45   : text + "M"
      Case 46   : text + "N"
      Case 47   : text + "O"
      Case 48   : text + "P"
      Case 49   : text + "Q"
      Case 50   : text + "R"
      Case 51   : text + "S"
      Case 52   : text + "T"
      Case 53   : text + "U"
      Case 54   : text + "V"
      Case 55   : text + "W"
      Case 56   : text + "X"
      Case 57   : text + "Y"
      Case 58   : text + "Z"
      Case 59   : text + "["
      Case 60   : text + "\"
      Case 61   : text + "]"
      Case 62   : text + "^"
      Case 63   : text + "_"
      Case 64   : text + "`"
      Case 65   : text + "a"
      Case 66   : text + "b"
      Case 67   : text + "c"
      Case 68   : text + "d"
      Case 69   : text + "e"
      Case 70   : text + "f"
      Case 71   : text + "g"
      Case 72   : text + "h"
      Case 73   : text + "i"
      Case 74   : text + "j"
      Case 75   : text + "k"
      Case 76   : text + "l"
      Case 77   : text + "m"
      Case 78   : text + "n"
      Case 79   : text + "o"
      Case 80   : text + "p"
      Case 81   : text + "q"
      Case 82   : text + "r"
      Case 83   : text + "s"
      Case 84   : text + "t"
      Case 85   : text + "u"
      Case 86   : text + "v"
      Case 87   : text + "w"
      Case 88   : text + "x"
      Case 89   : text + "y"
      Case 90   : text + "z"
      Case 91   : text + "{"
      Case 92   : text + "|"
      Case 93   : text + "}"
      Case 94   : text + "~"
      Case 95   : text + "&#741;"
      Case 96   : text + "&#742;"
      Case 97   : text + "&#743;"
      Case 98   : text + "&#744;"
      Case 99   : text + "&#745;"
      Case 100  : text + "&#746;"
      Case 101  : text + "&#747;"
      Case 102  : text + "&#708;"
      Case 103  : text + "&#709;"
    EndSelect
    result = "b2,s1,b1,s2,b1,s4"
    value = 0
    For counter = 1 To Len(text)
      char = Mid(text, counter, 1)
      Select char       
        Case " " :      result + ",b2,s1,b2,s2,b2,s2"
        Case "!" :      result + ",b2,s2,b2,s1,b2,s2"
        Case #DQUOTE$ : result + ",b2,s2,b2,s2,b2,s1"
        Case "#" :      result + ",b1,s2,b1,s2,b2,s3"
        Case "$" :      result + ",b1,s2,b1,s3,b2,s2"
        Case "%" :      result + ",b1,s3,b1,s2,b2,s2"
        Case "&" :      result + ",b1,s2,b2,s2,b1,s3"
        Case "'" :      result + ",b1,s2,b2,s3,b1,s2"
        Case "(" :      result + ",b1,s3,b2,s2,b1,s2"
        Case ")" :      result + ",b2,s2,b1,s2,b1,s3"
        Case "*" :      result + ",b2,s2,b1,s3,b1,s2"
        Case "+" :      result + ",b2,s3,b1,s2,b1,s2"
        Case "," :      result + ",b1,s1,b2,s2,b3,s2"
        Case "-" :      result + ",b1,s2,b2,s1,b3,s2"
        Case "." :      result + ",b1,s2,b2,s2,b3,s1"
        Case "/" :      result + ",b1,s1,b3,s2,b2,s2"
        Case "0" :      result + ",b1,s2,b3,s1,b2,s2"
        Case "1" :      result + ",b1,s2,b3,s2,b2,s1"
        Case "2" :      result + ",b2,s2,b3,s2,b1,s1"
        Case "3" :      result + ",b2,s2,b1,s1,b3,s2"
        Case "4" :      result + ",b2,s2,b1,s2,b3,s1"
        Case "5" :      result + ",b2,s1,b3,s2,b1,s2"
        Case "6" :      result + ",b2,s2,b3,s1,b1,s2"
        Case "7" :      result + ",b3,s1,b2,s1,b3,s1"
        Case "8" :      result + ",b3,s1,b1,s2,b2,s2"
        Case "9" :      result + ",b3,s2,b1,s1,b2,s2"
        Case ":" :      result + ",b3,s2,b1,s2,b2,s1"
        Case ";" :      result + ",b3,s1,b2,s2,b1,s2"
        Case "<" :      result + ",b3,s2,b2,s1,b1,s2"
        Case "=" :      result + ",b3,s2,b2,s2,b1,s1"
        Case ">" :      result + ",b2,s1,b2,s1,b2,s3"
        Case "?" :      result + ",b2,s1,b2,s3,b2,s1"
        Case "@" :      result + ",b2,s3,b2,s1,b2,s1"
        Case "A" :      result + ",b1,s1,b1,s3,b2,s3"
        Case "B" :      result + ",b1,s3,b1,s1,b2,s3"
        Case "C" :      result + ",b1,s3,b1,s3,b2,s1"
        Case "D" :      result + ",b1,s1,b2,s3,b1,s3"
        Case "E" :      result + ",b1,s3,b2,s1,b1,s3"
        Case "F" :      result + ",b1,s3,b2,s3,b1,s1"
        Case "G" :      result + ",b2,s1,b1,s3,b1,s3"
        Case "H" :      result + ",b2,s3,b1,s1,b1,s3"
        Case "I" :      result + ",b2,s3,b1,s3,b1,s1"
        Case "J" :      result + ",b1,s1,b2,s1,b3,s3"
        Case "K" :      result + ",b1,s1,b2,s3,b3,s1"
        Case "L" :      result + ",b1,s3,b2,s1,b3,s1"
        Case "M" :      result + ",b1,s1,b3,s1,b2,s3"
        Case "N" :      result + ",b1,s1,b3,s3,b2,s1"
        Case "O" :      result + ",b1,s3,b3,s1,b2,s1"
        Case "P" :      result + ",b3,s1,b3,s1,b2,s1"
        Case "Q" :      result + ",b2,s1,b1,s3,b3,s1"
        Case "R" :      result + ",b2,s3,b1,s1,b3,s1"
        Case "S" :      result + ",b2,s1,b3,s1,b1,s3"
        Case "T" :      result + ",b2,s1,b3,s3,b1,s1"
        Case "U" :      result + ",b2,s1,b3,s1,b3,s1"
        Case "V" :      result + ",b3,s1,b1,s1,b2,s3"
        Case "W" :      result + ",b3,s1,b1,s3,b2,s1"
        Case "X" :      result + ",b3,s3,b1,s1,b2,s1"
        Case "Y" :      result + ",b3,s1,b2,s1,b1,s3"
        Case "Z" :      result + ",b3,s1,b2,s3,b1,s1"
        Case "[" :      result + ",b3,s3,b2,s1,b1,s1"
        Case "\" :      result + ",b3,s1,b4,s1,b1,s1"
        Case "]" :      result + ",b2,s2,b1,s4,b1,s1"
        Case "^" :      result + ",b4,s3,b1,s1,b1,s1"
        Case "_" :      result + ",b1,s1,b1,s2,b2,s4"
        Case "`" :      result + ",b1,s1,b1,s4,b2,s2"
        Case "a" :      result + ",b1,s2,b1,s1,b2,s4"
        Case "b" :      result + ",b1,s2,b1,s4,b2,s1"
        Case "c" :      result + ",b1,s4,b1,s1,b2,s2"
        Case "d" :      result + ",b1,s4,b1,s2,b2,s1"
        Case "e" :      result + ",b1,s1,b2,s2,b1,s4"
        Case "f" :      result + ",b1,s1,b2,s4,b1,s2"
        Case "g" :      result + ",b1,s2,b2,s1,b1,s4"
        Case "h" :      result + ",b1,s2,b2,s4,b1,s1"
        Case "i" :      result + ",b1,s4,b2,s1,b1,s2"
        Case "j" :      result + ",b1,s4,b2,s2,b1,s1"
        Case "k" :      result + ",b2,s4,b1,s2,b1,s1"
        Case "l" :      result + ",b2,s2,b1,s1,b1,s4"
        Case "m" :      result + ",b4,s1,b3,s1,b1,s1"
        Case "n" :      result + ",b2,s4,b1,s1,b1,s2"
        Case "o" :      result + ",b1,s3,b4,s1,b1,s1"
        Case "p" :      result + ",b1,s1,b1,s2,b4,s2"
        Case "q" :      result + ",b1,s2,b1,s1,b4,s2"
        Case "r" :      result + ",b1,s2,b1,s2,b4,s1"
        Case "s" :      result + ",b1,s1,b4,s2,b1,s2"
        Case "t" :      result + ",b1,s2,b4,s1,b1,s2"
        Case "u" :      result + ",b1,s2,b4,s2,b1,s1"
        Case "v" :      result + ",b4,s1,b1,s2,b1,s2"
        Case "w" :      result + ",b4,s2,b1,s1,b1,s2"
        Case "x" :      result + ",b4,s2,b1,s2,b1,s1"
        Case "y" :      result + ",b2,s1,b2,s1,b4,s1"
        Case "z" :      result + ",b2,s1,b4,s1,b2,s1"
        Case "{" :      result + ",b4,s1,b2,s1,b2,s1"
        Case "|" :      result + ",b1,s1,b1,s1,b4,s3"
        Case "}" :      result + ",b1,s1,b1,s3,b4,s1"
        Case "~" :      result + ",b1,s3,b1,s1,b4,s1"
        Case "&#741;" :      result + ",b1,s1,b4,s1,b1,s3"
        Case "&#742;" :      result + ",b1,s1,b4,s3,b1,s1"
        Case "&#743;" :      result + ",b4,s1,b1,s1,b1,s3"
        Case "&#744;" :      result + ",b4,s1,b1,s3,b1,s1"
        Case "&#745;" :      result + ",b1,s1,b3,s1,b4,s1"
        Case "&#746;" :      result + ",b1,s1,b4,s1,b3,s1"
        Case "&#747;" :      result + ",b3,s1,b1,s1,b4,s1"
        Case "&#708;" :      result + ",b4,s1,b1,s1,b3,s1"
        Case "&#709;" :      result + ",b2,s1,b1,s4,b1,s2"
      EndSelect
    Next
    result + ",b2,s3,b3,s1,b1,s1,b2,"         
  EndIf
  ProcedureReturn result
    
EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

Procedure.s Get_BarcodeEAN8(text.s)
  
  Define.l counter, value, weight
  Define.s digit, char, parity, result = ""
  
  If text <> #Null$
    text      = Right("00000000" + text, 7)
    value     = 0
    weight    = 3
    For counter = 1 To 7
      char = Mid(ReverseString(text), counter, 1)
      Select char                                     
        Case "0" : value + (0 * Weight)
        Case "1" : value + (1 * Weight)
        Case "2" : value + (2 * Weight)
        Case "3" : value + (3 * Weight)
        Case "4" : value + (4 * Weight)
        Case "5" : value + (5 * Weight)
        Case "6" : value + (6 * Weight)
        Case "7" : value + (7 * Weight)
        Case "8" : value + (8 * Weight)
        Case "9" : value + (9 * Weight)
      EndSelect
      weight + 2 
      If weight = 5 
        weight = 1 
      EndIf
    Next counter
    Define.l checksum = 0
    While Mod(value + checksum, 10) <> 0
      checksum = checksum + 1
    Wend
    text + Str(checksum)
    DISPLAYTEXT = text
    ;
    result    = "b1,s1,b1"
    For counter = 1 To 4
      char = Mid(text, counter, 1)
      Select char                                     
        Case "0" : result + ",s1,s1,s1,b1,b1,s1,b1"
        Case "1" : result + ",s1,s1,b1,b1,s1,s1,b1"
        Case "2" : result + ",s1,s1,b1,s1,s1,b1,b1"
        Case "3" : result + ",s1,b1,b1,b1,b1,s1,b1"
        Case "4" : result + ",s1,b1,s1,s1,s1,b1,b1"
        Case "5" : result + ",s1,b1,b1,s1,s1,s1,b1"
        Case "6" : result + ",s1,b1,s1,b1,b1,b1,b1"
        Case "7" : result + ",s1,b1,b1,b1,s1,b1,b1"
        Case "8" : result + ",s1,b1,b1,s1,b1,b1,b1"
        Case "9" : result + ",s1,s1,s1,b1,s1,b1,b1"
      EndSelect
    Next counter
    result + ",s1,b1,s1,b1,s1"
    For counter = 5 To 8
      char = Mid(text, counter, 1)
      Select char                                     
        Case "0" : result + ",b1,b1,b1,s1,s1,b1,s1"
        Case "1" : result + ",b1,b1,s1,s1,b1,b1,s1"
        Case "2" : result + ",b1,b1,s1,b1,b1,s1,s1"
        Case "3" : result + ",b1,s1,s1,s1,s1,b1,s1"
        Case "4" : result + ",b1,s1,b1,b1,b1,s1,s1"
        Case "5" : result + ",b1,s1,s1,b1,b1,b1,s1"
        Case "6" : result + ",b1,s1,b1,s1,s1,s1,s1"
        Case "7" : result + ",b1,s1,s1,s1,b1,s1,s1"
        Case "8" : result + ",b1,s1,s1,b1,s1,s1,s1"
        Case "9" : result + ",b1,b1,b1,s1,b1,s1,s1"
      EndSelect
    Next counter
    result + ",b1,s1,b1,"
  EndIf
  ProcedureReturn result

EndProcedure
  
Procedure.s Get_BarcodeEAN13(text.s)
  
  Define.l counter, value, weight
  Define.s digit, char, parity, result = ""
  
  If text <> #Null$
    text      = Right("0000000000000" + text, 12)
    result    = "b1,s1,b1"
    value     = 0
    weight    = 3
    For counter = 1 To 13
      char = Mid(ReverseString(text), counter, 1)
      Select char                                     
        Case "0" : value + (0 * Weight)
        Case "1" : value + (1 * Weight)
        Case "2" : value + (2 * Weight)
        Case "3" : value + (3 * Weight)
        Case "4" : value + (4 * Weight)
        Case "5" : value + (5 * Weight)
        Case "6" : value + (6 * Weight)
        Case "7" : value + (7 * Weight)
        Case "8" : value + (8 * Weight)
        Case "9" : value + (9 * Weight)
      EndSelect
      weight + 2 
      If weight = 5 
        weight = 1 
      EndIf
    Next counter
    Define.l checksum = 0
    While Mod(value + checksum, 10) <> 0
      checksum = checksum + 1
    Wend
    text + Str(checksum)
    DISPLAYTEXT = text
    ;
    Select Left(text, 1)
      Case "0" : parity = "000000"
      Case "1" : parity = "001011"
      Case "2" : parity = "001101"
      Case "3" : parity = "001110"
      Case "4" : parity = "010011"
      Case "5" : parity = "011001"
      Case "6" : parity = "011100"
      Case "7" : parity = "010101"
      Case "8" : parity = "010110"
      Case "9" : parity = "011010"     
    EndSelect
    ;
    For counter = 1 To 6
      digit = Mid(text, counter + 1, 1)
      Select digit   
        Case "0"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s3,b2,s1,b1"
            Case "1" : result + ",s1,b1,s2,b3"
          EndSelect
        Case "1"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s2,b2,s2,b1"
            Case "1" : result + ",s1,b2,s2,b2"
          EndSelect
        Case "2"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s2,b1,s2,b2"
            Case "1" : result + ",s2,b2,s1,b2"
          EndSelect
        Case "3"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s1,b4,s1,b1"
            Case "1" : result + ",s1,b1,s4,b1"
          EndSelect
        Case "4"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s1,b1,s3,b2"
            Case "1" : result + ",s2,b3,s1,b1"
          EndSelect
        Case "5"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s1,b2,s3,b1"
            Case "1" : result + ",s1,b3,s2,b1"
          EndSelect
        Case "6"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s1,b1,s1,b4"
            Case "1" : result + ",s4,b1,s1,b1"
          EndSelect
        Case "7"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s1,b3,s1,b2"
            Case "1" : result + ",s2,b1,s3,b1"
          EndSelect
        Case "8"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s1,b2,s1,b3"
            Case "1" : result + ",s3,b1,s2,b1"
          EndSelect
        Case "9"
          Select Mid(parity, counter, 1)
            Case "0" : result + ",s3,b1,s1,b2"
            Case "1" : result + ",s2,b1,s1,b3"
          EndSelect
      EndSelect           
    Next counter
    result + ",s1,b1,s1,b1,s1"
    For counter = 8 To 13
      char = Mid(text, counter, 1)
      Select char                                     
        Case "0" : result + ",b1,b1,b1,s1,s1,b1,s1"
        Case "1" : result + ",b1,b1,s1,s1,b1,b1,s1"
        Case "2" : result + ",b1,b1,s1,b1,b1,s1,s1"
        Case "3" : result + ",b1,s1,s1,s1,s1,b1,s1"
        Case "4" : result + ",b1,s1,b1,b1,b1,s1,s1"
        Case "5" : result + ",b1,s1,s1,b1,b1,b1,s1"
        Case "6" : result + ",b1,s1,b1,s1,s1,s1,s1"
        Case "7" : result + ",b1,s1,s1,s1,b1,s1,s1"
        Case "8" : result + ",b1,s1,s1,b1,s1,s1,s1"
        Case "9" : result + ",b1,b1,b1,s1,b1,s1,s1"
      EndSelect
    Next counter
    result + ",b1,s1,b1,"
  EndIf
  ProcedureReturn result

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************
;-

Procedure Draw_Barcode(ImageNr.l, Coding.l, text.s, PosX, PosY, BarWidth, BarHeight, Flag.i = #TEXT_NONE, Color.i = #Black, Back.i = #White)
  
  Define.f _FONTSIZE = 9.3 * BarWidth * 1.02
  Define.l _FTOPTION = 0
  If coding = #BARCODE_POSTNET
    _FONTSIZE / 1.5
    _FTOPTION = #PB_Font_Bold
  EndIf
  Define FONT_DEFAULT.i = LoadFont(#PB_Any, "Consolas", _FONTSIZE, _FTOPTION)
  ;
  DISPLAYTEXT = #Null$
  If IsImage(ImageNr)
    If StartDrawing(ImageOutput(ImageNr))
      Define.s codebarre
      Define.i counter, TextPosX = PosX
      Select Coding
        Case #BARCODE_11          : codebarre = Get_Barcode11       (text)
        Case #BARCODE_39          : codebarre = Get_Barcode39       (text)
        Case #BARCODE_2of5        : codebarre = Get_Barcode2of5     (text)
        Case #BARCODE_93          : codebarre = Get_Barcode93       (text)
        Case #BARCODE_EAN_8       : codebarre = Get_BarcodeEAN8     (text)
        Case #BARCODE_EAN_13      : codebarre = Get_BarcodeEAN13    (text)
        Case #BARCODE_POSTNET     : If BarHeight <> BarWidth * 10
                                      BarHeight = BarWidth * 10
                                    EndIf
                                    If Flag <> #TEXT_NONE And Flag <> #TEXT_CENTER
                                      If Flag <> #TEXT_NONE
                                        Flag = #TEXT_CENTER
                                      EndIf
                                    EndIf
                                    codebarre = Get_BarcodePostNet  (text)
        Case #BARCODE_128         : codebarre = Get_Barcode128      (text)
      EndSelect
      Define.s thsSquare
      Define.l numSquare = CountString(codebarre, ",")
      If numSquare > 0
        For counter = 1 To numSquare
          thsSquare = StringField(codebarre, counter, ",")
          Select thsSquare
            Case "b1" : Box(PosX, PosY, BarWidth,     BarHeight, Color)
                        PosX +  BarWidth * 1
            Case "b2" : Box(PosX, PosY, BarWidth * 2, BarHeight, Color)
                        PosX + (BarWidth * 2)
            Case "b3" : Box(PosX, PosY, BarWidth * 3, BarHeight, Color)
                        PosX + (BarWidth * 3)
            Case "b4" : Box(PosX, PosY, BarWidth * 4, BarHeight, Color)
                        PosX + (BarWidth * 4)
            Case "c1" : Box(PosX, PosY + (BarHeight / 2) + (BarWidth/2), BarWidth, (BarHeight / 2) - (BarWidth/2), Color)
                        PosX +  BarWidth * 1
            Case "s1" : PosX +  BarWidth * 1
            Case "s2" : PosX + (BarWidth * 2)
            Case "s3" : PosX + (BarWidth * 3)
            Case "s4" : PosX + (BarWidth * 4)
          EndSelect
        Next counter
      EndIf
      Select Flag
        Case #TEXT_CENTER
          DrawingFont(FontID(FONT_DEFAULT))
          Define.l BarcodeLength  = PosX - TextPosX
          Define.l TextLength     = TextWidth(DISPLAYTEXT)
          Define.l NewPosX        = (BarcodeLength/2) - (TextLength/2)
          DrawText(TextPosX + NewPosX, PosY + BarHeight, DISPLAYTEXT, Color, Back)
        Case #TEXT_CENTER_IN
          DrawingFont(FontID(FONT_DEFAULT))
          Define.l BarcodeLength  = PosX - TextPosX
          Define.l TextLength     = TextWidth(" " + DISPLAYTEXT + " ")
          Define.l NewPosX        = (BarcodeLength / 2) - (TextLength / 2)
          DrawText(TextPosX + NewPosX - 1, PosY + BarHeight - TextHeight(DISPLAYTEXT), " " + DISPLAYTEXT + " ", Color, Back)   
        Case #TEXT_EAN, #TEXT_EAN_TITLE, #TEXT_UCPA
          Select Coding
            Case #BARCODE_EAN_8
              DrawingFont(FontID(FONT_DEFAULT))
              text = Left(DISPLAYTEXT, 1)
              Define.l TextWidth  = TextWidth (text)
              Define.l TextHeight = TextHeight(text)
              Define.l NewPosY    = (PosY + BarHeight) - (TextHeight / 2)
              Box(TextPosX + (BarWidth * 4),  NewPosY, (BarWidth * 28), TextHeight, $ffffff)
              Box(TextPosX + (BarWidth * 36), NewPosY, (BarWidth * 28), TextHeight, $ffffff)
              DrawText(TextPosX - TextWidth - (BarWidth * 2),   NewPosY, "<", Color, Back)
              text = Mid(DISPLAYTEXT, 1, 4)
              DrawText(TextPosX + (BarWidth * 4),  NewPosY, text, Color, Back)
              text = Right(DISPLAYTEXT, 4)
              DrawText(TextPosX + (BarWidth * 36), NewPosY, text, Color, Back)
              DrawText(TextPosX + (BarWidth * 68) + 1, NewPosY, ">",  Color, Back)
            Case #BARCODE_EAN_13
              If Flag <> #TEXT_UCPA
                DrawingFont(FontID(FONT_DEFAULT))
                text = Left(DISPLAYTEXT, 1)
                Define.l TextWidth  = TextWidth (text)
                Define.l TextHeight = TextHeight(text)
                Define.l NewPosY    = (PosY + BarHeight) - (TextHeight / 2)
                Box(TextPosX + (BarWidth * 6),  NewPosY, (BarWidth * 40), TextHeight, $ffffff)
                Box(TextPosX + (BarWidth * 50), NewPosY, (BarWidth * 40), TextHeight, $ffffff)
                Select Flag
                  Case #TEXT_EAN_TITLE
                    DrawText(TextPosX - TextWidth - (BarWidth * 2), PosY + (BarHeight - TextHeight) * 0.5, text, Color, Back)
                  Default
                    DrawText(TextPosX - TextWidth - (BarWidth * 2), NewPosY, text, Color, Back)
                EndSelect
                text = Mid(DISPLAYTEXT, 2, 6)
                DrawText(TextPosX + (BarWidth * 4),  NewPosY, text, Color, Back)
                text = Right(DISPLAYTEXT, 6)
                DrawText(TextPosX + (BarWidth * 50), NewPosY, text, Color, Back)
              Else
                DrawingFont(FontID(FONT_DEFAULT))
                text = Mid(DISPLAYTEXT, 1, 1)
                Define.l TextWidth  = TextWidth (text)
                Define.l TextHeight = TextHeight(text)
                Define.l NewPosY    = (PosY + BarHeight) - (TextHeight / 2)
                Box(TextPosX + (BarWidth * 6),  NewPosY, (BarWidth * 40), TextHeight, $ffffff)
                Box(TextPosX + (BarWidth * 50), NewPosY, (BarWidth * 40), TextHeight, $ffffff)
                DrawText(TextPosX - TextWidth - (BarWidth * 2), NewPosY, text, Color, Back)
                text = Mid(DISPLAYTEXT, 2, 5)
                DrawText(TextPosX + (BarWidth * 6) + 2,  NewPosY, text  , Color, Back)
                text = Mid(DISPLAYTEXT, 7, 5)
                DrawText(TextPosX + (BarWidth * 52), NewPosY, text, Color, Back)
                text = Mid(DISPLAYTEXT, 12, 1)
                DrawText(TextPosX + (BarWidth * 95) + 3, NewPosY, text,  Color, Back)
              EndIf
          EndSelect
      EndSelect
      StopDrawing()
    EndIf
  EndIf

EndProcedure

; ****************************************************************************
; ****************************************************************************
; ****************************************************************************

If OpenWindow(0, 0, 0, 800, 900, "BarCode", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  Define.i event
  If CreateImage(0, 800, 900, 24, #White)
    Draw_Barcode(0, #BARCODE_128, "BARCODE 128", 100, 100, BARWIDTH, 100, #TEXT_CENTER)
    Draw_Barcode(0, #BARCODE_39, "01 / 123456001", 100, 250, BARWIDTH, 100, #TEXT_CENTER)
    Draw_Barcode(0, #BARCODE_2of5, "1234567890", 100, 400, BARWIDTH, 100, #TEXT_CENTER)
    Draw_Barcode(0, #BARCODE_93, "CODE 93", 100, 550, BARWIDTH, 100, #TEXT_CENTER)
    Draw_Barcode(0, #BARCODE_EAN_13, "590123412345", 100, 700, BARWIDTH, 100, #TEXT_UCPA)
    Draw_Barcode(0, #BARCODE_EAN_8, "9031101", 400, 700, BARWIDTH, 100, #TEXT_EAN)
    Draw_Barcode(0, #BARCODE_EAN_128, "12345678901", 400, 550, BARWIDTH, 100, #TEXT_CENTER)
    Draw_Barcode(0, #BARCODE_11, "01-23-45-67", 400, 400, BARWIDTH, 100, #TEXT_CENTER)
    Draw_Barcode(0, #BARCODE_POSTNET, "59280-1234", 400, 550, BARWIDTH, 100, #TEXT_CENTER)
    ImageGadget(1, 0, 0, 800, 600, ImageID(0))
  EndIf
  ;
  Repeat
    event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf
Cordialement,
GallyHC
Dernière modification par GallyHC le ven. 14/févr./2020 17:17, modifié 1 fois.
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: BarCode (code2of5,code11,code128,code39,code93,EAN8/13,.

Message par Thyphoon »

Merci GallyHC :mrgreen: très interessant et beau boulot pour ce que tu as corrigé et ajouté ! 8)
Avatar de l’utilisateur
venom
Messages : 3072
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: BarCode (code2of5,code11,code128,code39,code93,EAN8/13,.

Message par venom »

Je n'en ai pas l'utilité pour le moment, mais merci pour le partage et l'effort apporté.






@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: BarCode (code2of5,code11,code128,code39,code93,EAN8/13,.

Message par Kwai chang caine »

Ca fait plaisir de te lire :wink:
Merci à TeddyLM et à toi pour le partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
MLD
Messages : 1103
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: BarCode (code2of5,code11,code128,code39,code93,EAN8/13,.

Message par MLD »

Merci Galy et TeddyLM
kwandjeen
Messages : 204
Inscription : dim. 16/juil./2006 21:44

Re: BarCode (code2of5,code11,code128,code39,code93,EAN8/13,.

Message par kwandjeen »

Merci pour la partage. :D
Avatar de l’utilisateur
Ar-S
Messages : 9477
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: BarCode (code2of5,code11,code128,code39,code93,EAN8/13,.

Message par Ar-S »

Merci, ça a l'air de bien marcher.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Répondre