Génération de Code-Barre
Module Barcode : un module PureBasic autonome pour générer 13 types de codes-barres 1D et 2D (EAN, Code 128, QR Code, DataMatrix, PDF417, CMC7…) sous forme d’images prêtes à afficher ou à imprimer, avec gestion des accents et de l’UTF-8.
Module Barcode pour PureBasic
Un module PureBasic qui génère des codes-barres directement en image, sans DLL ni bibliothèque externe, pour l’écran, les documents ou les imprimantes de ticket.
Formats : Code 39, 93, 128, Code 11, 2 parmi 5, EAN-8, EAN-13, PostNet, QR Code, DataMatrix, PDF417 et CMC7 (police des chèques).
Points forts : une seule fonction pour une image prête à l’emploi, un rendu net même en impression thermique, les accents en UTF-8, et des couleurs, tailles et niveaux de correction réglables.
Crédits : code original de TeddyLM, QR Code d’après Project Nayuki / infratec et tables PDF417 issues de pdf417gen (licences MIT).
Le code source
; +======================================================+
; | MODULE DE CREATION DE CODE A BARRE |
; +------------------------------------------------------+
; | COPYRIGHT(C)2021-2026, ALL RIGHT RESERVED KOAKDESIGN |
; +--------------+---------------------------------------+
; | Program type | PUREBASIC 5.71 LTS (MODULE) |
; +--------------+---------------------------------------+
; | VER & REV | 0.0.4 |
; +--------------+---------------------------------------+
; | Program name | |
; +======================================================+
; +======================================================+
; | Original Version: 0.0.1 |
; +--------------+---------------------------------------+
; | Created by | GallyHomeCorp |
; | Graphix by | GallyHomeCorp |
; +--------------+---------------------------------------+
; | Comments: | |
; +--------------+ |
; | |
; | PostNet, 2Of5, code-11, code-39, code-93, code-128 |
; | EAN-8, EAN-13, QRCode, CMC7, DataMatrix, PDF417 |
; | |
; | 0.0.2 : Create_BarcodeImage, marges (quiet zone), |
; | QR échelle entière + UTF-8, CMC7 finalisé, |
; | police libérée, handle image en .i (x64) |
; | 0.0.3 : DataMatrix ECC200 (carré / rectangle), |
; | taille max réglable (défaut 32x32), |
; | cadres rouges de test retirés, |
; | CMC7 : barres découpées en forme de glyphe |
; | 0.0.4 : PDF417 (texte/octets/numérique, UTF-8) |
; | 0.0.5 : QR code : niveau de correction réglable |
; | (setBarcode_qrlevel, -1 = automatique) |
; | |
; +======================================================+
; +==========================+===========================+
; | Operating System | Gestion Compilation |
; +----------------------+---+-----------------------+---+
; | Window | X | Gestion Thread | |
; | Linux | X | Gestion OnError | |
; | MacOS | X | | - |
; +----------------------+---+-----------------------+---+
; | x32 | X | Droit Administrateur | |
; | X64 | X | Droit particulier | |
; +======================+===+=======================+===+
; CODE ORIGINAL : TeddyLM
; https://www.purebasic.fr/english/viewtopic.php?p=533663#p533663
; ****************************************************************************
DisableASM
CompilerIf #PB_Compiler_EnableExplicit
EnableExplicit
CompilerEndIf
; ****************************************************************************
;-DeclareModule
DeclareModule barcode_2d
Enumeration barcode_2d_type
#BARCODE_2of5
#BARCODE_11
#BARCODE_39
#BARCODE_93
#BARCODE_128
#BARCODE_EAN_8
#BARCODE_EAN_13
#BARCODE_EAN_128
#BARCODE_POSTNET
#BARCODE_PDF417
#BARCODE_QRCODE
#BARCODE_DATAMATRIX
#BARCODE_CMC7
EndEnumeration
Enumeration barcode_2d_text
#TEXT_NONE
#TEXT_CENTER
#TEXT_CENTER_IN
#TEXT_EAN
#TEXT_EAN_TITLE
#TEXT_UCPA
EndEnumeration
Enumeration barcode_2d_dmshape
#DM_SHAPE_SQUARE ; DataMatrix carré (défaut)
#DM_SHAPE_RECTANGLE ; rectangle (repli sur carré si texte trop long)
#DM_SHAPE_AUTO ; le plus petit, carré ou rectangle
EndEnumeration
; ****************************************************************************
Declare.l getBarcode_width ()
Declare setBarcode_width (width.l)
Declare.i getBarcode_color ()
Declare setBarcode_color (color.i)
Declare.i getBarcode_backcolor ()
Declare setBarcode_backcolor (color.i)
Declare.l getBarcode_quietzone ()
Declare setBarcode_quietzone (modules.l)
Declare.l getBarcode_dmshape ()
Declare setBarcode_dmshape (shape.l)
Declare.l getBarcode_dmmaxsize ()
Declare setBarcode_dmmaxsize (modules.l)
Declare.l getBarcode_cmc7glyph ()
Declare setBarcode_cmc7glyph (state.l)
Declare.l getBarcode_pdf417columns ()
Declare setBarcode_pdf417columns (columns.l)
Declare.l getBarcode_pdf417security ()
Declare setBarcode_pdf417security (level.l)
Declare.l getBarcode_pdf417rowheight ()
Declare setBarcode_pdf417rowheight (ratio.l)
Declare.l getBarcode_qrlevel ()
Declare setBarcode_qrlevel (level.l)
Declare.i BarCodeWidth (Coding.l, text.s, BarHeight)
Declare Draw_Barcode (ImageNr.i, Coding.l, text.s, PosX, PosY, BarHeight, Flag.i = #TEXT_NONE)
Declare.i Create_BarcodeImage (Coding.l, text.s, BarHeight, Flag.i = #TEXT_NONE)
EndDeclareModule
; ****************************************************************************
;-Module
Module barcode_2d
DisableASM
CompilerIf #PB_Compiler_EnableExplicit
EnableExplicit
CompilerEndIf
; ****************************************************************************
;- Include des modules pour les codebarre
XIncludeFile("module_barcode_qrcode.pbi")
XIncludeFile("module_barcode_datamatrix.pbi")
XIncludeFile("module_barcode_pdf417.pbi")
; ****************************************************************************
#QR_QUIETZONE = 4 ; marge QR imposée par la norme (en modules)
#DM_QUIETZONE = 2 ; marge DataMatrix (norme : 1 minimum, 2 par sécurité en thermique)
Global DMSHAPE.l = #DM_SHAPE_SQUARE
Global DMMAXSIZE.l = 144 ; DataMatrix : taille max en modules (32 = 32x32, 2x2 cases), 0 = sans limite
#CMC7_GLYPH_ROWS = 13 ; hauteur des glyphes CMC7 (en lignes)
Global CMC7GLYPH.l = #True ; CMC7 : barres découpées en forme de caractère (#False = barres pleines)
#PDF_QUIETZONE = 2 ; PDF417 : marge en modules (norme : 2)
Global PDFCOLUMNS.l = 0 ; PDF417 : colonnes de données (1..30), 0 = automatique
Global PDFSECURITY.l = -1 ; PDF417 : niveau de correction (0..8), -1 = automatique
Global PDFROWRATIO.l = 3 ; PDF417 : hauteur d'une ligne en modules
Global QRLEVEL.l = -1 ; QR : correction d'erreur -1 = automatique (L + montée auto), 0 = L, 1 = M, 2 = Q, 3 = H
Global DISPLAYTEXT.s = #Null$
Global BARWIDTH.l = 2
Global BARFORECOLOR.i = 0
Global BARBACKCOLOR.i = #White
Global QUIETZONE.l = 10 ; marge des codes 1D (en modules de BarWidth)
; ****************************************************************************
;-
;
;
; @author GallyHomeCorp
; @param string
; @param validate
; @return
Procedure.b isValidString(string.s, validate.s)
Define.l i = 0
Define.b result = #True
If string <> #Null$ And validate <> #Null$
For i = 1 To Len(string)
If FindString(validate, Mid(string, i, 1), 1) = 0
result = #False
Break
EndIf
Next i
Else
result = #False
EndIf
;
ProcedureReturn result
EndProcedure
; ****************************************************************************
;-
;
;
; @author
; @return
Procedure.l getBarcode_width()
ProcedureReturn BARWIDTH
EndProcedure
;
;
; @author
; @return
Procedure setBarcode_width(width.l)
BARWIDTH = width
EndProcedure
;
;
; @author
; @return
Procedure.i getBarcode_color()
ProcedureReturn BARFORECOLOR
EndProcedure
;
;
; @author
; @return
Procedure setBarcode_color(color.i)
BARFORECOLOR = color
EndProcedure
;
;
; @author
; @return
Procedure.i getBarcode_backcolor()
ProcedureReturn BARBACKCOLOR
EndProcedure
;
;
; @author
; @return
Procedure setBarcode_backcolor(color.i)
BARBACKCOLOR = color
EndProcedure
; Marge blanche gauche/droite des codes 1D, en modules (10 = valeur usuelle)
Procedure.l getBarcode_quietzone()
ProcedureReturn QUIETZONE
EndProcedure
Procedure setBarcode_quietzone(modules.l)
If modules < 0
modules = 0
EndIf
QUIETZONE = modules
EndProcedure
; Forme du DataMatrix : #DM_SHAPE_SQUARE, #DM_SHAPE_RECTANGLE ou #DM_SHAPE_AUTO
Procedure.l getBarcode_dmshape()
ProcedureReturn DMSHAPE
EndProcedure
Procedure setBarcode_dmshape(shape.l)
If shape < #DM_SHAPE_SQUARE Or shape > #DM_SHAPE_AUTO
shape = #DM_SHAPE_SQUARE
EndIf
DMSHAPE = shape
EndProcedure
; Taille maximale du DataMatrix en modules (plus grand côté), 0 = sans limite.
; Si le texte ne tient pas dans cette taille, aucun code n'est généré (retour 0).
Procedure.l getBarcode_dmmaxsize()
ProcedureReturn DMMAXSIZE
EndProcedure
Procedure setBarcode_dmmaxsize(modules.l)
If modules < 0
modules = 0
EndIf
DMMAXSIZE = modules
EndProcedure
; CMC7 : #True = barres découpées en forme de caractère (défaut), #False = barres pleines
Procedure.l getBarcode_cmc7glyph()
ProcedureReturn CMC7GLYPH
EndProcedure
Procedure setBarcode_cmc7glyph(state.l)
CMC7GLYPH = Bool(state <> 0)
EndProcedure
; QR code : niveau de correction d'erreur
; -1 = automatique (niveau L, relevé tant que le QR ne grossit pas)
; 0 = L (7 %) 1 = M (15 %) 2 = Q (25 %) 3 = H (30 %) : niveau imposé
Procedure.l getBarcode_qrlevel()
ProcedureReturn QRLEVEL
EndProcedure
Procedure setBarcode_qrlevel(level.l)
If level < -1
level = -1
EndIf
If level > 3
level = 3
EndIf
QRLEVEL = level
EndProcedure
Procedure.i QR_Ecc()
If QRLEVEL < 0
ProcedureReturn #qrcodegen_Ecc_LOW
EndIf
ProcedureReturn #qrcodegen_Ecc_LOW + QRLEVEL
EndProcedure
Procedure.i QR_Boost()
ProcedureReturn Bool(QRLEVEL < 0)
EndProcedure
; PDF417 : nombre de colonnes de données (1..30), 0 = automatique
Procedure.l getBarcode_pdf417columns()
ProcedureReturn PDFCOLUMNS
EndProcedure
Procedure setBarcode_pdf417columns(columns.l)
If columns < 0
columns = 0
EndIf
If columns > 30
columns = 30
EndIf
PDFCOLUMNS = columns
EndProcedure
; PDF417 : niveau de correction d'erreurs (0..8), -1 = automatique
Procedure.l getBarcode_pdf417security()
ProcedureReturn PDFSECURITY
EndProcedure
Procedure setBarcode_pdf417security(level.l)
If level < -1
level = -1
EndIf
If level > 8
level = 8
EndIf
PDFSECURITY = level
EndProcedure
; PDF417 : hauteur d'une ligne en modules (3 = valeur recommandée)
Procedure.l getBarcode_pdf417rowheight()
ProcedureReturn PDFROWRATIO
EndProcedure
Procedure setBarcode_pdf417rowheight(ratio.l)
If ratio < 1
ratio = 1
EndIf
PDFROWRATIO = ratio
EndProcedure
; ****************************************************************************
;-
Procedure.s Get_BarcodePostNet(text.s)
If isValidString(text, "0123456789")
Define.l counter
Define.s char, result = #Null$
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
EndIf
EndProcedure
Procedure.s Get_Barcode2of5(text.s)
If isValidString(text, "0123456789")
Define.l counter, Loop
Define.s char1, char2
Define.s result= #Null$, result1 = #Null$, result2 = #Null$
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 = #Null$
result2 = #Null$
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 = #Null$
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 Loop
Next counter
result + ",b2,s1,b1,"
EndIf
ProcedureReturn result
EndIf
EndProcedure
; ****************************************************************************
Procedure.s Get_Barcode11(text.s)
If isValidString(text, "0123456789-")
Define.l counter
Define.s char, sgap, interchar = ",s1", result = #Null$
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
EndIf
EndProcedure
; ****************************************************************************
Procedure.s Get_Barcode39(text.s)
text = UCase(text)
If isValidString(text, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%")
Define.l counter
Define.s char, sgap, result = #Null$
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
EndIf
EndProcedure
; ****************************************************************************
Procedure.s Get_Barcode93(text.s)
text = UCase(text)
If isValidString(text, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%")
Define.l counter, value, weight
Define.s char, reverse, result = #Null$
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 counter
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 counter
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 counter
result + ",b1,s1,b1,s1,b1,b1,b1,b1,s1,b1,"
EndIf
ProcedureReturn result
EndIf
EndProcedure
; ****************************************************************************
Procedure.s Get_Barcode128(text.s)
If isValidString(text, "!" + #DQUOTE$ + " #$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~")
Define.l counter, value
Define.s char, result = #Null$
DISPLAYTEXT = text
If text <> #Null$
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 counter
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 + "Ë¥"
Case 96 : text + "˦"
Case 97 : text + "˧"
Case 98 : text + "˨"
Case 99 : text + "Ë©"
Case 100 : text + "˪"
Case 101 : text + "Ë«"
Case 102 : text + "Ë„"
;Case 103 : text + "Ë…" >> MODULO 103 (DE 0 A 102)?
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 "Ë¥" : result + ",b1,s1,b4,s1,b1,s3"
Case "˦" : result + ",b1,s1,b4,s3,b1,s1"
Case "˧" : result + ",b4,s1,b1,s1,b1,s3"
Case "˨" : result + ",b4,s1,b1,s3,b1,s1"
Case "Ë©" : result + ",b1,s1,b3,s1,b4,s1"
Case "˪" : result + ",b1,s1,b4,s1,b3,s1"
Case "Ë«" : result + ",b3,s1,b1,s1,b4,s1"
Case "Ë„" : result + ",b4,s1,b1,s1,b3,s1"
Case "Ë…" : result + ",b2,s1,b1,s4,b1,s2"
EndSelect
Next counter
result + ",b2,s3,b3,s1,b1,s1,b2,"
EndIf
ProcedureReturn result
EndIf
EndProcedure
; ****************************************************************************
Procedure.s Get_BarcodeEAN8(text.s)
If isValidString(text, "0123456789")
Define.l counter, value, weight
Define.s digit, char, parity, result = #Null$
If text <> #Null$
text = Right("00000000" + text, 7)
value = 0
weight = 3
For counter = 1 To 7
char = Mid(ReverseString(text), counter, 1)
value + (Val(char) * Weight)
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
EndIf
EndProcedure
Procedure.s Get_BarcodeEAN13(text.s)
If isValidString(text, "0123456789")
Define.l counter, value, weight
Define.s digit, char, parity, result = #Null$
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)
value + (Val(char) * Weight)
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 + ",b3,s2,b1,s1"
Case "1" : result + ",b2,s2,b2,s1"
Case "2" : result + ",b2,s1,b2,s2"
Case "3" : result + ",b1,s4,b1,s1"
Case "4" : result + ",b1,s1,b3,s2"
Case "5" : result + ",b1,s2,b3,s1"
Case "6" : result + ",b1,s1,b1,s4"
Case "7" : result + ",b1,s3,b1,s2"
Case "8" : result + ",b1,s2,b1,s3"
Case "9" : result + ",b3,s1,b1,s2"
EndSelect
Next counter
result + ",b1,s1,b1,"
EndIf
ProcedureReturn result
EndIf
EndProcedure
; ****************************************************************************
; CMC7 (ISO 1004) : chaque caractère = 7 barres + 6 intervalles,
; dont exactement 2 longs (s2) et 4 courts (s1) -> 15 combinaisons.
; Proportions (en BarWidth) : barre 1, intervalle court 1, intervalle long 2,
; espace entre caractères 6 (pas de 21 modules ~ 3,175 mm pour une barre de 0,15 mm).
;
; Symboles : / = S1 < = S2 # = S3 > = S4 ^ = S5
; Espace " " = un emplacement de caractère vide (séparation des zones).
;
; Glyphes CMC7 : 13 lignes x 7 colonnes, une colonne par barre du caractère
; ("#" = encre). Chaque colonne contient de l'encre, pour que les 7 barres restent lisibles.
; Chiffres : formes dessinées dans l'esprit du CMC7.
; Symboles S1..S5 : formes relevées sur de vrais caractères CMC7 (codage des intervalles vérifié).
Procedure.s Get_CMC7Glyph(char.s)
Define.s glyph = #Empty$
Select char
Case "0" : glyph = ".#####." + "#######" + "##...##" + "##...##" + "##...##" + "##...##" + "##...##" + "##...##" + "##...##" + "##...##" + "##...##" + "#######" + ".#####."
Case "1" : glyph = "...##.." + "..###.." + ".####.." + "##.##.." + "...##.." + "...##.." + "...##.." + "...##.." + "...##.." + "...##.." + "...##.." + "#######" + "#######"
Case "2" : glyph = ".#####." + "#######" + "##...##" + ".....##" + ".....##" + "....###" + "..####." + ".###..." + "##....." + "##....." + "##....." + "#######" + "#######"
Case "3" : glyph = ".#####." + "#######" + "##...##" + ".....##" + ".....##" + "..####." + "..####." + ".....##" + ".....##" + ".....##" + "##...##" + "#######" + ".#####."
Case "4" : glyph = "....##." + "...###." + "..####." + ".##.##." + "##..##." + "##..##." + "#######" + "#######" + "....##." + "....##." + "....##." + "....##." + "....##."
Case "5" : glyph = "#######" + "#######" + "##....." + "##....." + "##....." + "######." + "#######" + ".....##" + ".....##" + ".....##" + "##...##" + "#######" + ".#####."
Case "6" : glyph = ".#####." + "#######" + "##...##" + "##....." + "##....." + "######." + "#######" + "##...##" + "##...##" + "##...##" + "##...##" + "#######" + ".#####."
Case "7" : glyph = "#######" + "#######" + ".....##" + "....##." + "....##." + "...##.." + "...##.." + "..##..." + "..##..." + "..##..." + "..##..." + "..##..." + "..##..."
Case "8" : glyph = ".#####." + "#######" + "##...##" + "##...##" + "##...##" + ".#####." + ".#####." + "##...##" + "##...##" + "##...##" + "##...##" + "#######" + ".#####."
Case "9" : glyph = ".#####." + "#######" + "##...##" + "##...##" + "##...##" + "#######" + ".######" + ".....##" + ".....##" + ".....##" + "##...##" + "#######" + ".#####."
Case "/" : glyph = "....###" + "...####" + "..#####" + ".######" + "#######" + "#######" + "#######" + "#######" + "######." + "#####.." + "###...." + "##....." + "#......"
Case "<" : glyph = "....###" + "....###" + "....###" + "....###" + "#######" + "#######" + "#######" + "#######" + "#######" + "#######" + "#######" + "#######" + "#######"
Case "#" : glyph = "#######" + "#######" + "#######" + "#######" + "#######" + "#######" + "#######" + "......." + "......." + "......." + "#######" + "#######" + "#######"
Case ">" : glyph = "####..." + "####..." + "#######" + "#######" + "#######" + "....###" + "....###" + "....###" + "#######" + "#######" + "#######" + "####..." + "####..."
Case "^" : glyph = ".#####." + "######." + "#######" + "#######" + "#######" + "######." + "######." + "######." + "#######" + "###.###" + "##...##" + "#....##" + "......#"
Default : glyph = LSet("", 7 * #CMC7_GLYPH_ROWS, "#") ; inconnu : barres pleines
EndSelect
ProcedureReturn glyph
EndProcedure
; Dessin : avec setBarcode_cmc7glyph(#True) (défaut), chaque barre est découpée pour que
; les 7 barres forment le caractère (voir Get_CMC7Glyph). Les positions des barres et
; des intervalles restent celles de la norme : c'est ce que lisent les lecteurs.
; Hauteur effective du CMC7 :
; BarHeight <= 0 : automatique, proportionnelle à l'épaisseur du trait (BarWidth)
; ligne de glyphe = 1,5 x BarWidth -> environ 19,5 modules de haut
; (proportions du CMC7 : barre 0,15 mm pour ~2,8 mm de haut)
; BarHeight > 0 : taille libre, arrondie au multiple de 13 inférieur (lignes régulières)
Procedure.i CMC7_Height(BarHeight)
Define.i rowPx
If BarHeight > 0 And CMC7GLYPH = 0
ProcedureReturn BarHeight ; barres pleines : pas besoin d'arrondir
EndIf
If BarHeight <= 0
rowPx = (BARWIDTH * 3 + 1) / 2
Else
rowPx = BarHeight / #CMC7_GLYPH_ROWS
EndIf
If rowPx < 1
rowPx = 1
EndIf
ProcedureReturn rowPx * #CMC7_GLYPH_ROWS
EndProcedure
Procedure.s Get_BarcodeCMC7(text.s)
Define.l counter, last
Define.s char, result = #Empty$
Define.s interchar = "s4,s2," ; 6 modules entre deux caractères
Define.s blank = "s4,s4,s4,s4,s4,s1," ; 21 modules = un caractère vide
If isValidString(text, "0123456789/<#>^ ")
DISPLAYTEXT = text
last = Len(text)
For counter = 1 To last
char = Mid(text, counter, 1)
; intervalles : 1 2 3 4 5 6
Select char
Case "0" : result + "b1,s1,b1,s1,b1,s2,b1,s2,b1,s1,b1,s1,b1," ; 001100
Case "1" : result + "b1,s2,b1,s1,b1,s1,b1,s1,b1,s2,b1,s1,b1," ; 100010
Case "2" : result + "b1,s1,b1,s2,b1,s2,b1,s1,b1,s1,b1,s1,b1," ; 011000
Case "3" : result + "b1,s2,b1,s1,b1,s2,b1,s1,b1,s1,b1,s1,b1," ; 101000
Case "4" : result + "b1,s2,b1,s1,b1,s1,b1,s2,b1,s1,b1,s1,b1," ; 100100
Case "5" : result + "b1,s1,b1,s1,b1,s1,b1,s2,b1,s2,b1,s1,b1," ; 000110
Case "6" : result + "b1,s1,b1,s1,b1,s2,b1,s1,b1,s2,b1,s1,b1," ; 001010
Case "7" : result + "b1,s2,b1,s2,b1,s1,b1,s1,b1,s1,b1,s1,b1," ; 110000
Case "8" : result + "b1,s1,b1,s2,b1,s1,b1,s1,b1,s2,b1,s1,b1," ; 010010
Case "9" : result + "b1,s1,b1,s2,b1,s1,b1,s2,b1,s1,b1,s1,b1," ; 010100
Case "/" : result + "b1,s2,b1,s1,b1,s1,b1,s1,b1,s1,b1,s2,b1," ; 100001 S1
Case "<" : result + "b1,s1,b1,s2,b1,s1,b1,s1,b1,s1,b1,s2,b1," ; 010001 S2
Case "#" : result + "b1,s1,b1,s1,b1,s2,b1,s1,b1,s1,b1,s2,b1," ; 001001 S3
Case ">" : result + "b1,s1,b1,s1,b1,s1,b1,s2,b1,s1,b1,s2,b1," ; 000101 S4
Case "^" : result + "b1,s1,b1,s1,b1,s1,b1,s1,b1,s2,b1,s2,b1," ; 000011 S5
Case " " : result + blank
EndSelect
; pas constant : caractère (15) + interchar (6) = 21 modules = emplacement vide
If counter < last And char <> " "
result + interchar
EndIf
Next counter
EndIf
ProcedureReturn result
EndProcedure
; ****************************************************************************
;-
; Police du texte sous le code. Taille corrigée du facteur DPI pour que
; le texte fasse la même taille en pixels quelle que soit la mise à l'échelle Windows
Procedure.i LoadBarcodeFont(Coding.l)
Define.f size = 9.3 * BARWIDTH * 1.02
Define.l option = 0
Define.s name
If Coding = #BARCODE_POSTNET
size / 1.5
option = #PB_Font_Bold
EndIf
size / DesktopResolutionY()
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows : name = "Consolas"
CompilerCase #PB_OS_Linux : name = "DejaVu Sans Mono"
CompilerCase #PB_OS_MacOS : name = "Menlo"
CompilerEndSelect
ProcedureReturn LoadFont(#PB_Any, name, size, option)
EndProcedure
; ****************************************************************************
;-
; Largeur des barres seules (sans marges) pour les codes 1D.
; Pour le QR : largeur totale de l'image, marge de 4 modules incluse.
; Retourne -1 si le type n'est pas géré.
Procedure.i BarCodeWidth(Coding.l, text.s, BarHeight)
Define.s codebarre, thsSquare
Define.i counter, PosX, img
Select Coding
Case #BARCODE_2of5 : codebarre = Get_Barcode2of5 (text)
Case #BARCODE_11 : codebarre = Get_Barcode11 (text)
Case #BARCODE_39 : codebarre = Get_Barcode39 (text)
Case #BARCODE_93 : codebarre = Get_Barcode93 (text)
Case #BARCODE_128 : codebarre = Get_Barcode128 (text)
Case #BARCODE_EAN_8 : codebarre = Get_BarcodeEAN8 (text)
Case #BARCODE_EAN_13 : codebarre = Get_BarcodeEAN13 (text)
Case #BARCODE_CMC7 : codebarre = Get_BarcodeCMC7 (text)
Case #BARCODE_POSTNET : codebarre = Get_BarcodePostNet (text)
Case #BARCODE_QRCODE
img = Get_BarcodeQRCODE(text, BARFORECOLOR, BARBACKCOLOR, BarHeight, #QR_QUIETZONE, QR_Ecc(), QR_Boost())
If img
PosX = ImageWidth(img)
FreeImage(img)
ProcedureReturn PosX
EndIf
ProcedureReturn -1
Case #BARCODE_DATAMATRIX
img = Get_BarcodeDATAMATRIX(text, BARFORECOLOR, BARBACKCOLOR, BarHeight, #DM_QUIETZONE, DMSHAPE, DMMAXSIZE)
If img
PosX = ImageWidth(img)
FreeImage(img)
ProcedureReturn PosX
EndIf
ProcedureReturn -1
Case #BARCODE_PDF417
img = Get_BarcodePDF417(text, BARFORECOLOR, BARBACKCOLOR, BARWIDTH, BarHeight, PDFCOLUMNS, PDFSECURITY, PDFROWRATIO, #PDF_QUIETZONE)
If img
PosX = ImageWidth(img)
FreeImage(img)
ProcedureReturn PosX
EndIf
ProcedureReturn -1
Default
ProcedureReturn -1 ; EAN-128 : non implémenté
EndSelect
Define.l numSquare = CountString(codebarre, ",")
If numSquare > 0
For counter = 1 To numSquare
thsSquare = StringField(codebarre, counter, ",")
Select thsSquare
Case "b1" : PosX + BarWidth * 1
Case "b2" : PosX + BarWidth * 2
Case "b3" : PosX + BarWidth * 3
Case "b4" : PosX + BarWidth * 4
Case "c1" : 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
ProcedureReturn PosX
EndProcedure
; ****************************************************************************
;-
Procedure Draw_Barcode(_SRCIMAGE.i, Coding.l, text.s, PosX, PosY, BarHeight, Flag.i = #TEXT_NONE)
Define.i _SAVIMAGE = 0
Define.i FONT_DEFAULT = 0
DISPLAYTEXT = #Null$
If IsImage(_SRCIMAGE)
Define.s codebarre
Define.i counter, TextPosX = PosX
Select Coding
Case #BARCODE_2of5 : codebarre = Get_Barcode2of5 (text)
Case #BARCODE_11 : codebarre = Get_Barcode11 (text)
Case #BARCODE_39 : codebarre = Get_Barcode39 (text)
Case #BARCODE_93 : codebarre = Get_Barcode93 (text)
Case #BARCODE_128 : codebarre = Get_Barcode128 (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
Flag = #TEXT_CENTER
EndIf
codebarre = Get_BarcodePostNet (text)
Case #BARCODE_PDF417 : _SAVIMAGE = Get_BarcodePDF417 (text, BARFORECOLOR, BARBACKCOLOR, BARWIDTH, BarHeight, PDFCOLUMNS, PDFSECURITY, PDFROWRATIO, #PDF_QUIETZONE)
Case #BARCODE_QRCODE : _SAVIMAGE = Get_BarcodeQRCODE (text, BARFORECOLOR, BARBACKCOLOR, BarHeight, #QR_QUIETZONE, QR_Ecc(), QR_Boost())
Case #BARCODE_DATAMATRIX : _SAVIMAGE = Get_BarcodeDATAMATRIX (text, BARFORECOLOR, BARBACKCOLOR, BarHeight, #DM_QUIETZONE, DMSHAPE, DMMAXSIZE)
Case #BARCODE_CMC7 : Flag = #TEXT_NONE
BarHeight = CMC7_Height(BarHeight)
codebarre = Get_BarcodeCMC7 (text)
EndSelect
; CMC7 : barres découpées pour dessiner la forme du caractère
Define.i cmc7Mode = Bool(Coding = #BARCODE_CMC7 And CMC7GLYPH <> 0 And codebarre <> #Null$)
Define.s cmc7Chars = ReplaceString(text, " ", "") ; un glyphe par caractère non vide
Define.s cmc7Glyphres
Define.i strokeIndex = 0, stroke, glyphRow, ya, yb
; Police chargée seulement si on écrit du texte (et libérée en fin de procédure)
If Flag <> #TEXT_NONE And _SAVIMAGE = 0
FONT_DEFAULT = LoadBarcodeFont(Coding)
EndIf
If StartDrawing(ImageOutput(_SRCIMAGE))
If _SAVIMAGE = 0 Or IsImage(_SAVIMAGE) = 0
Define.s thsSquare
Define.l numSquare = CountString(codebarre, ",")
If numSquare > 0
For counter = 1 To numSquare
thsSquare = StringField(codebarre, counter, ",")
Select thsSquare
Case "b1" : If cmc7Mode
; barre n° stroke (0..6) du caractère courant : on ne trace que les lignes du glyphe
stroke = strokeIndex % 7
If stroke = 0
cmc7Glyphres = Get_CMC7Glyph(Mid(cmc7Chars, strokeIndex / 7 + 1, 1))
EndIf
Box(PosX, PosY, BarWidth, BarHeight, BARBACKCOLOR)
For glyphRow = 0 To #CMC7_GLYPH_ROWS - 1
If Mid(cmc7Glyphres, glyphRow * 7 + stroke + 1, 1) = "#"
ya = PosY + (glyphRow * BarHeight) / #CMC7_GLYPH_ROWS
yb = PosY + ((glyphRow + 1) * BarHeight) / #CMC7_GLYPH_ROWS
Box(PosX, ya, BarWidth, yb - ya, BARFORECOLOR)
EndIf
Next glyphRow
strokeIndex + 1
Else
Box(PosX, PosY, BarWidth, BarHeight, BARFORECOLOR)
EndIf
PosX + BarWidth * 1
Case "b2" : Box(PosX, PosY, BarWidth * 2, BarHeight, BARFORECOLOR)
PosX + BarWidth * 2
Case "b3" : Box(PosX, PosY, BarWidth * 3, BarHeight, BARFORECOLOR)
PosX + BarWidth * 3
Case "b4" : Box(PosX, PosY, BarWidth * 4, BarHeight, BARFORECOLOR)
PosX + BarWidth * 4
Case "c1" : Box(PosX, PosY, BarWidth, BarHeight, BARBACKCOLOR)
Box(PosX, PosY + (BarHeight / 2) + (BarWidth/2), BarWidth, (BarHeight / 2) - (BarWidth/2), BARFORECOLOR)
PosX + BarWidth * 1
Case "s1" : Box(PosX, PosY, BarWidth, BarHeight, BARBACKCOLOR)
PosX + BarWidth * 1
Case "s2" : Box(PosX, PosY, BarWidth * 2, BarHeight, BARBACKCOLOR)
PosX + BarWidth * 2
Case "s3" : Box(PosX, PosY, BarWidth * 3, BarHeight, BARBACKCOLOR)
PosX + BarWidth * 3
Case "s4" : Box(PosX, PosY, BarWidth * 4, BarHeight, BARBACKCOLOR)
PosX + BarWidth * 4
EndSelect
Next counter
EndIf
If IsFont(FONT_DEFAULT)
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, BARFORECOLOR, BARBACKCOLOR)
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 + " ", BARFORECOLOR, BARBACKCOLOR)
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, "<", BARFORECOLOR, BARBACKCOLOR)
text = Mid(DISPLAYTEXT, 1, 4)
DrawText(TextPosX + (BarWidth * 4), NewPosY, text, BARFORECOLOR, BARBACKCOLOR)
text = Right(DISPLAYTEXT, 4)
DrawText(TextPosX + (BarWidth * 36), NewPosY, text, BARFORECOLOR, BARBACKCOLOR)
DrawText(TextPosX + (BarWidth * 68) + 1, NewPosY, ">", BARFORECOLOR, BARBACKCOLOR)
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, BARFORECOLOR, BARBACKCOLOR)
Default
DrawText(TextPosX - TextWidth - (BarWidth * 2), NewPosY, text, BARFORECOLOR, BARBACKCOLOR)
EndSelect
text = Mid(DISPLAYTEXT, 2, 6)
DrawText(TextPosX + (BarWidth * 4), NewPosY, text, BARFORECOLOR, BARBACKCOLOR)
text = Right(DISPLAYTEXT, 6)
DrawText(TextPosX + (BarWidth * 50), NewPosY, text, BARFORECOLOR, BARBACKCOLOR)
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, BARFORECOLOR, BARBACKCOLOR)
text = Mid(DISPLAYTEXT, 2, 5)
DrawText(TextPosX + (BarWidth * 6) + 2, NewPosY, text, BARFORECOLOR, BARBACKCOLOR)
text = Mid(DISPLAYTEXT, 7, 5)
DrawText(TextPosX + (BarWidth * 52), NewPosY, text, BARFORECOLOR, BARBACKCOLOR)
text = Mid(DISPLAYTEXT, 12, 1)
DrawText(TextPosX + (BarWidth * 95) + 3, NewPosY, text, BARFORECOLOR, BARBACKCOLOR)
EndIf
EndSelect
EndSelect
EndIf
Else
Select Coding
Case #BARCODE_QRCODE, #BARCODE_DATAMATRIX, #BARCODE_PDF417
; Image déjà à l'échelle entière, marge blanche incluse : pas de ResizeImage
DrawImage(ImageID(_SAVIMAGE), PosX, PosY)
EndSelect
EndIf
StopDrawing()
EndIf
If _SAVIMAGE And IsImage(_SAVIMAGE)
FreeImage(_SAVIMAGE)
EndIf
EndIf
If IsFont(FONT_DEFAULT)
FreeFont(FONT_DEFAULT)
EndIf
EndProcedure
; ****************************************************************************
;-
; Crée une image #PB_Any contenant le code prêt à coller :
; marges blanches incluses (QUIETZONE pour le 1D, 4 modules pour le QR),
; hauteur ajustée au texte. Pour le QR, BarHeight = taille maximale en pixels.
; Retourne 0 en cas d'échec (texte invalide, type non géré...).
; L'image est à libérer par l'appelant (FreeImage).
Procedure.i Create_BarcodeImage(Coding.l, text.s, BarHeight, Flag.i = #TEXT_NONE)
Define.i img, tmp, font, w, qzL, qzR, extraH, th, cw
If Coding = #BARCODE_QRCODE
ProcedureReturn Get_BarcodeQRCODE(text, BARFORECOLOR, BARBACKCOLOR, BarHeight, #QR_QUIETZONE, QR_Ecc(), QR_Boost())
EndIf
If Coding = #BARCODE_PDF417 ; BarHeight = largeur maximale en pixels (0 = libre)
ProcedureReturn Get_BarcodePDF417(text, BARFORECOLOR, BARBACKCOLOR, BARWIDTH, BarHeight, PDFCOLUMNS, PDFSECURITY, PDFROWRATIO, #PDF_QUIETZONE)
EndIf
If Coding = #BARCODE_DATAMATRIX
ProcedureReturn Get_BarcodeDATAMATRIX(text, BARFORECOLOR, BARBACKCOLOR, BarHeight, #DM_QUIETZONE, DMSHAPE, DMMAXSIZE)
EndIf
If Coding = #BARCODE_POSTNET
BarHeight = BARWIDTH * 10
If Flag <> #TEXT_NONE : Flag = #TEXT_CENTER : EndIf
EndIf
If Coding = #BARCODE_CMC7
BarHeight = CMC7_Height(BarHeight) ; 0 = hauteur automatique
EndIf
w = BarCodeWidth(Coding, text, BarHeight)
If w <= 0
ProcedureReturn 0
EndIf
qzL = QUIETZONE * BARWIDTH
qzR = qzL
If Flag <> #TEXT_NONE
; Mesure du texte avec la même police que Draw_Barcode
font = LoadBarcodeFont(Coding)
If IsFont(font)
tmp = CreateImage(#PB_Any, 8, 8)
If tmp
If StartDrawing(ImageOutput(tmp))
DrawingFont(FontID(font))
th = TextHeight("0")
cw = TextWidth ("<")
StopDrawing()
EndIf
FreeImage(tmp)
EndIf
FreeFont(font)
EndIf
Select Flag
Case #TEXT_CENTER
extraH = th
Case #TEXT_EAN, #TEXT_EAN_TITLE, #TEXT_UCPA
If Coding = #BARCODE_EAN_8 Or Coding = #BARCODE_EAN_13
extraH = th - (th / 2)
; chiffres / chevrons dessinés à gauche et à droite des barres
If qzL < cw + BARWIDTH * 2 + 2 : qzL = cw + BARWIDTH * 2 + 2 : EndIf
If qzR < cw + BARWIDTH * 2 + 4 : qzR = cw + BARWIDTH * 2 + 4 : EndIf
EndIf
EndSelect
EndIf
img = CreateImage(#PB_Any, qzL + w + qzR, BarHeight + extraH, 24, BARBACKCOLOR)
If img
Draw_Barcode(img, Coding, text, qzL, 0, BarHeight, Flag)
EndIf
ProcedureReturn img
EndProcedure
EndModule
;
; QR Code generator library (C)
;
; Copyright (c) Project Nayuki. (MIT License)
; https://www.nayuki.io/page/qr-code-generator-library
; https://github.com/nayuki/QR-Code-generator
;
; converted to PB by infratec 2020-01-07
;
; https://www.purebasic.fr/english/viewtopic.php?f=12&t=76558
;
; infos:
; https://www.qrcode.com/en/about/version.html
;
; 2020-01-09 17:41 fixed boostEcl
; 2020-01-09 20:30 fixed getNumRawDataModules()
; 2020-01-10 00:56 fixed applyMask()
; 2020-01-10 21:25 added qrcodegen_CreateTextImage()
;
; 2026-10-12 Get_BarcodeQRCODE : échelle entière (TargetSize), zone blanche (QuietZone=4),
; encodage UTF-8 en mode octet ; qrcodegen_encodeText : texte vide corrigé
;
DisableASM
CompilerIf Not #PB_Compiler_EnableExplicit
EnableExplicit
CompilerEndIf
;-PB Help stuff
Structure AsciiStructure
a.a[0]
EndStructure
#INT16_MAX = $7fff
#SIZE_MAX = $ffffffff
#LONG_MAX = $7fffffff
;-From Header
;-Enumerations
Enumeration qrcodegen_Ecc
; Must be declared in ascending order of error protection
; so that an internal qrcodegen function works properly
#qrcodegen_Ecc_LOW ; The QR Code can tolerate about 7% erroneous codewords
#qrcodegen_Ecc_MEDIUM ; The QR Code can tolerate about 15% erroneous codewords
#qrcodegen_Ecc_QUARTILE ; The QR Code can tolerate about 25% erroneous codewords
#qrcodegen_Ecc_HIGH ; The QR Code can tolerate about 30% erroneous codewords
EndEnumeration
Enumeration qrcodegen_Mask
; A special value To tell the QR Code encoder To
; automatically Select an appropriate mask pattern
#qrcodegen_Mask_AUTO = -1
; The eight actual mask patterns
#qrcodegen_Mask_0 = 0
#qrcodegen_Mask_1
#qrcodegen_Mask_2
#qrcodegen_Mask_3
#qrcodegen_Mask_4
#qrcodegen_Mask_5
#qrcodegen_Mask_6
#qrcodegen_Mask_7
EndEnumeration
Enumeration qrcodegen_Mode
#qrcodegen_Mode_NUMERIC = $1
#qrcodegen_Mode_ALPHANUMERIC = $2
#qrcodegen_Mode_BYTE = $4
#qrcodegen_Mode_KANJI = $8
#qrcodegen_Mode_ECI = $7
EndEnumeration
#qrcodegen_VERSION_MIN = 1 ; The minimum version number supported in the QR Code Model 2 standard
#qrcodegen_VERSION_MAX = 40 ; The maximum version number supported in the QR Code Model 2 standard
; Calculates the number of bytes needed To store any QR Code up To And including the given version number,
; As a compile-time constant. For example, 'uint8_t buffer[qrcodegen_BUFFER_LEN_FOR_VERSION(25)];'
; can store any single QR Code from version 1 To 25 (inclusive). The result fits in an Int (Or int16).
; Requires qrcodegen_VERSION_MIN <= n <= qrcodegen_VERSION_MAX.
Macro qrcodegen_BUFFER_LEN_FOR_VERSION(n)
((((n) * 4 + 17) * ((n) * 4 + 17) + 7) / 8 + 1)
EndMacro
; The worst-Case number of bytes needed To store one QR Code, up To And including
; version 40. This value equals 3918, which is just under 4 kilobytes.
; Use this more convenient value To avoid calculating tighter memory bounds For buffers.
#qrcodegen_BUFFER_LEN_MAX = qrcodegen_BUFFER_LEN_FOR_VERSION(#qrcodegen_VERSION_MAX)
Structure qrcodegen_Segment
; The mode indicator of this segment.
mode.i
; The length of this segment's unencoded data. Measured in characters for
; numeric/alphanumeric/kanji mode, bytes For byte mode, And 0 For ECI mode.
; Always zero Or positive. Not the same As the Data's bit length.
numChars.i
; The Data bits of this segment, packed in bitwise big endian.
; Can be null If the bit length is zero.
*data.AsciiStructure
; The number of valid Data bits used in the buffer. Requires
; 0 <= bitLength <= 32767, And bitLength <= (capacity of Data Array) * 8.
; The character count (numChars) must agree With the mode And the bit buffer length.
bitLength.i
EndStructure
;-From Main
#qrcodegen_ALPHANUMERIC_CHARSET$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ $%*+-./:" + #DQUOTE$ + ";"
DataSection
qrcodegen_internal_ECC_CODEWORDS_PER_BLOCK: ; [4][41]
Data.b -1, 7, 10, 15, 20, 26, 18, 20, 24, 30, 18, 20, 24, 26, 30, 22, 24, 28, 30, 28, 28, 28, 28, 30, 30, 26, 28, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30
Data.b -1, 10, 16, 26, 18, 24, 16, 18, 22, 22, 26, 30, 22, 22, 24, 24, 28, 28, 26, 26, 26, 26, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28
Data.b -1, 13, 22, 18, 26, 18, 24, 18, 22, 20, 24, 28, 26, 24, 20, 30, 24, 28, 28, 26, 30, 28, 30, 30, 30, 30, 28, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30
Data.b -1, 17, 28, 22, 16, 22, 28, 26, 26, 24, 28, 24, 28, 22, 24, 24, 30, 28, 28, 26, 28, 30, 24, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30
EndDataSection
#qrcodegen_REED_SOLOMON_DEGREE_MAX = 30 ; Based on the table above
DataSection
qrcodegen_internal_NUM_ERROR_CORRECTION_BLOCKS: ; [4][41]
Data.b -1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 4, 4, 4, 4, 4, 6, 6, 6, 6, 7, 8, 8, 9, 9, 10, 12, 12, 12, 13, 14, 15, 16, 17, 18, 19, 19, 20, 21, 22, 24, 25
Data.b -1, 1, 1, 1, 2, 2, 4, 4, 4, 5, 5, 5, 8, 9, 9, 10, 10, 11, 13, 14, 16, 17, 17, 18, 20, 21, 23, 25, 26, 28, 29, 31, 33, 35, 37, 38, 40, 43, 45, 47, 49
Data.b -1, 1, 1, 2, 2, 4, 4, 6, 6, 8, 8, 8, 10, 12, 16, 12, 17, 16, 18, 21, 20, 23, 23, 25, 27, 29, 34, 34, 35, 38, 40, 43, 45, 48, 51, 53, 56, 59, 62, 65, 68
Data.b -1, 1, 1, 2, 4, 4, 4, 5, 6, 8, 8, 11, 11, 16, 16, 18, 16, 19, 21, 25, 25, 25, 34, 30, 32, 35, 37, 40, 42, 45, 48, 51, 54, 57, 60, 63, 66, 70, 74, 77, 81
EndDataSection
; For automatic mask pattern selection.
#qrcodegen_PENALTY_N1 = 3
#qrcodegen_PENALTY_N2 = 3
#qrcodegen_PENALTY_N3 = 40
#qrcodegen_PENALTY_N4 = 10
;-Declarations
Declare.i qrcodegen_encodeText(text$, *tempBuffer.AsciiStructure, *qrcode.AsciiStructure, ecl.i, minVersion.i, maxVersion.i, mask.i, boostEcl.i)
Declare.i qrcodegen_encodeBinary(*dataAndTemp.AsciiStructure, dataLen.i, *qrcode.AsciiStructure, ecl.i, minVersion.i, maxVersion.i, mask.i, boostEcl.i)
Declare qrcodegen_internal_appendBitsToBuffer(val.i, numBits.i, *buffer.AsciiStructure, *bitLen.Integer)
Declare.i qrcodegen_encodeSegments(Array segs.qrcodegen_Segment(1), len.i, ecl.i, *tempBuffer.AsciiStructure, *qrcode.AsciiStructure)
Declare.i qrcodegen_encodeSegmentsAdvanced(Array segs.qrcodegen_Segment(1), len.i, ecl.i, minVersion.i, maxVersion.i, mask.i, boostEcl.i, *tempBuffer.AsciiStructure, *qrcode.AsciiStructure)
Declare qrcodegen_internal_addEccAndInterleave(*ata.AsciiStructure, version.i, ecl.i, *result.AsciiStructure)
Declare.i qrcodegen_internal_getNumDataCodewords(version.i, ecl.i)
Declare.i qrcodegen_internal_getNumRawDataModules(ver.i)
Declare qrcodegen_internal_reedSolomonComputeDivisor(degree.i, *result.AsciiStructure)
Declare qrcodegen_internal_reedSolomonComputeRemainder(*data.AsciiStructure, dataLen.i, *generator.AsciiStructure, degree.i, *result.AsciiStructure)
Declare.a qrcodegen_internal_reedSolomonMultiply(x.a, y.a)
Declare qrcodegen_internal_initializeFunctionModules(version.i, *qrcode.AsciiStructure)
Declare qrcodegen_internal_drawWhiteFunctionModules(*qrcode.AsciiStructure, version.i)
Declare qrcodegen_internal_drawFormatBits(ecl.i, mask.i, *qrcode.AsciiStructure)
Declare.i qrcodegen_internal_getAlignmentPatternPositions(version.i, Array result.a(1))
Declare qrcodegen_internal_fillRectangle(left.i, top.i, width.i, height.i, *qrcode.AsciiStructure)
Declare qrcodegen_internal_drawCodewords(*data.AsciiStructure, dataLen.i, *qrcode.AsciiStructure)
Declare qrcodegen_internal_applyMask(*functionModules.AsciiStructure, *qrcode.AsciiStructure, mask.i)
Declare.i qrcodegen_internal_getPenaltyScore(*qrcode.AsciiStructure)
Declare.i qrcodegen_internal_finderPenaltyCountPatterns(Array runHistory.i(1), qrsize.i)
Declare.i qrcodegen_internal_finderPenaltyTerminateAndCount(currentRunColor.i, currentRunLength.i, Array runHistory.i(1), qrsize.i)
Declare qrcodegen_internal_finderPenaltyAddHistory(currentRunLength.i, Array runHistory.i(1), qrsize.i)
Declare.i qrcodegen_getSize(*qrcode.AsciiStructure)
Declare.i qrcodegen_getModule(*qrcode.AsciiStructure, x.i, y.i)
Declare.i qrcodegen_internal_getModule(*qrcode.AsciiStructure, x.i, y.i)
Declare qrcodegen_internal_setModule(*qrcode.AsciiStructure, x.i, y.i, isBlack.i)
Declare qrcodegen_internal_setModuleBounded(*qrcode.AsciiStructure, x.i, y.i, isBlack.i)
Declare.i qrcodegen_internal_getBit(x.i, i.i)
Declare.i qrcodegen_isAlphanumeric(*text.Character)
Declare.i qrcodegen_isNumeric(*text.Character)
Declare.i qrcodegen_calcSegmentBufferSize(mode.i, numChars.i)
Declare.i qrcodegen_internal_calcSegmentBitLength(mode.i, numChars.i)
Declare.i qrcodegen_makeBytes(*data.AsciiStructure, len.i, *buf.AsciiStructure)
Declare.i qrcodegen_makeNumeric(digits$, *buf.AsciiStructure)
Declare.i qrcodegen_makeAlphanumeric(text$, *buf.AsciiStructure)
Declare.i qrcodegen_makeEci(assignVal.i, *buf.AsciiStructure)
Declare.i qrcodegen_internal_getTotalBits(Array segs.qrcodegen_Segment(1), len.i, version.i)
Declare.i qrcodegen_internal_numCharCountBits(mode.i, version.i)
;---- High-level QR Code encoding functions
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_encodeText(text$, *tempBuffer.AsciiStructure, *qrcode.AsciiStructure, ecl.i, minVersion.i, maxVersion.i, mask.i, boostEcl.i)
Protected Result.i, textLen.i, bufLen.i, i.i
Protected Dim seg.qrcodegen_Segment(0)
Protected *seg.qrcodegen_Segment
textLen = Len(text$)
If textLen = 0
Dim Dummy.qrcodegen_Segment(0)
; CORRIGÉ : sortie directe (avant, le code continuait et encodait une 2e fois)
ProcedureReturn qrcodegen_encodeSegmentsAdvanced(Dummy(), 0, ecl, minVersion, maxVersion, mask, boostEcl, *tempBuffer, *qrcode)
Else
bufLen = qrcodegen_BUFFER_LEN_FOR_VERSION(maxVersion)
If qrcodegen_isNumeric(@text$)
If qrcodegen_calcSegmentBufferSize(#qrcodegen_Mode_NUMERIC, textLen) > bufLen
;Goto fail
*qrcode\a[0] = 0
ProcedureReturn #False
EndIf
*seg = qrcodegen_makeNumeric(text$, *tempBuffer)
CopyStructure(*seg, @seg(0), qrcodegen_Segment)
ElseIf qrcodegen_isAlphanumeric(@text$)
If qrcodegen_calcSegmentBufferSize(#qrcodegen_Mode_ALPHANUMERIC, textLen) > bufLen
*qrcode\a[0] = 0
ProcedureReturn #False
EndIf
*seg = qrcodegen_makeAlphanumeric(Text$, *tempBuffer)
CopyStructure(*seg, @seg(0), qrcodegen_Segment)
Else
If textLen > bufLen
*qrcode\a[0] = 0
ProcedureReturn #False
EndIf
For i = 0 To textLen - 1
*tempBuffer\a[i] = Asc(Mid(text$, i + 1, 1))
Next i
seg(0)\mode = #qrcodegen_Mode_BYTE
seg(0)\bitLength = qrcodegen_internal_calcSegmentBitLength(seg(0)\mode, textLen)
If seg(0)\bitLength = -1
*qrcode\a[0] = 0
ProcedureReturn #False
EndIf
seg(0)\numChars = textLen
seg(0)\Data = *tempBuffer
EndIf
EndIf
ProcedureReturn qrcodegen_encodeSegmentsAdvanced(seg(), 1, ecl, minVersion, maxVersion, mask, boostEcl, *tempBuffer, *qrcode)
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_encodeBinary(*dataAndTemp.AsciiStructure, dataLen.i, *qrcode.AsciiStructure, ecl.i, minVersion.i, maxVersion.i, mask.i, boostEcl.i)
Protected Dim seg.qrcodegen_Segment(0)
seg(0)\mode = #qrcodegen_Mode_BYTE
seg(0)\bitLength = qrcodegen_internal_calcSegmentBitLength(seg(0)\mode, dataLen)
If seg(0)\bitLength = -1
*qrcode\a[0] = 0 ; Set size to invalid value for safety
ProcedureReturn #False
EndIf
seg(0)\numChars = dataLen
seg(0)\Data = *dataAndTemp
ProcedureReturn qrcodegen_encodeSegmentsAdvanced(seg(), 1, ecl, minVersion, maxVersion, mask, boostEcl, *dataAndTemp, *qrcode)
EndProcedure
; Appends the given number of low-order bits of the given value To the given byte-based
; bit buffer, increasing the bit length. Requires 0 <= numBits <= 16 And val < 2^numBits.
Procedure qrcodegen_internal_appendBitsToBuffer(val.i, numBits.i, *buffer.AsciiStructure, *bitLen.Integer)
Protected i.i
;assert(0 <= numBits && numBits <= 16 && (unsigned long)val >> numBits == 0)
;For (int i = numBits - 1; i >= 0; i--, (*bitLen)++)
; buffer[*bitLen >> 3] |= ((val >> i) & 1) << (7 - (*bitLen & 7));
; i = numBits - 1
; While i
; PokeA(*buffer + *bitLen\i >> 3, PeekA(*buffer + *bitLen\i >> 3) | ((val >> i) & 1) << (7 - (*bitLen\i & 7)))
; i - 1
; *bitLen\i + 1
; Wend
For i = numBits - 1 To 0 Step -1
*buffer\a[*bitLen\i >> 3] = *buffer\a[*bitLen\i >> 3] | (((val >> i) & 1) << (7 - (*bitLen\i & 7)))
*bitLen\i + 1
Next i
EndProcedure
;---- Low-level QR Code encoding functions
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_encodeSegments(Array segs.qrcodegen_Segment(1), len.i, ecl.i, *tempBuffer.AsciiStructure, *qrcode.AsciiStructure)
ProcedureReturn qrcodegen_encodeSegmentsAdvanced(segs(), len, ecl, #qrcodegen_VERSION_MIN, #qrcodegen_VERSION_MAX, #qrcodegen_Mask_AUTO, #True, *tempBuffer, *qrcode)
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_encodeSegmentsAdvanced(Array segs.qrcodegen_Segment(1), len.i, ecl.i, minVersion.i, maxVersion.i, mask.i, boostEcl.i, *tempBuffer.AsciiStructure, *qrcode.AsciiStructure)
Protected version.i, dataUsedBits.i, dataCapacityBits.i, terminatorBits.i, padByte.i
Protected i.i, bitLen.i, bit.i, j.i, minPenalty.i, msk.i, penalty.i
Protected *seg.qrcodegen_Segment
;assert(segs != NULL || len == 0);
;assert(qrcodegen_VERSION_MIN <= minVersion && minVersion <= maxVersion && maxVersion <= qrcodegen_VERSION_MAX);
;assert(0 <= (int)ecl && (int)ecl <= 3 && -1 <= (int)mask && (int)mask <= 7);
; Find the minimal version number To use
version = minVersion
Repeat
dataCapacityBits = qrcodegen_internal_getNumDataCodewords(version, ecl) * 8 ; Number of data bits available
dataUsedBits = qrcodegen_internal_getTotalBits(segs(), len, version)
If dataUsedBits <> -1 And dataUsedBits <= dataCapacityBits
Break ; This version number is found to be suitable
EndIf
If version >= maxVersion ; All versions in the range could Not fit the given Data
*qrcode\a[0] = 0 ; Set size to invalid value for safety
ProcedureReturn #False
EndIf
version + 1
ForEver
;assert(dataUsedBits != -1);
; Increase the error correction level While the Data still fits in the current version number
For i = #qrcodegen_Ecc_MEDIUM To #qrcodegen_Ecc_HIGH ; From low to high
If boostEcl And dataUsedBits <= qrcodegen_internal_getNumDataCodewords(version, i) * 8
ecl = i
EndIf
Next i
; Concatenate all segments To create the Data bit string
;memset(qrcode, 0, (size_t)qrcodegen_BUFFER_LEN_FOR_VERSION(version) * SizeOf(qrcode[0]));
FillMemory(*qrcode, qrcodegen_BUFFER_LEN_FOR_VERSION(version) * 1, 0)
For i = 0 To len - 1
*seg = @segs(i)
qrcodegen_internal_appendBitsToBuffer(*seg\mode, 4, *qrcode, @bitLen)
qrcodegen_internal_appendBitsToBuffer(*seg\numChars, qrcodegen_internal_numCharCountBits(*seg\mode, version), *qrcode, @bitLen)
For j = 0 To *seg\bitLength - 1
bit = (*seg\Data\a[j >> 3] >> (7 - (j & 7))) & 1
qrcodegen_internal_appendBitsToBuffer(bit, 1, *qrcode, @bitLen)
Next j
Next i
;assert(bitLen == dataUsedBits);
; Add terminator And pad up To a byte If applicable
dataCapacityBits = qrcodegen_internal_getNumDataCodewords(version, ecl) * 8
;assert(bitLen <= dataCapacityBits)
terminatorBits = dataCapacityBits - bitLen;
If terminatorBits > 4
terminatorBits = 4
EndIf
qrcodegen_internal_appendBitsToBuffer(0, terminatorBits, *qrcode, @bitLen)
qrcodegen_internal_appendBitsToBuffer(0, (8 - bitLen % 8) % 8, *qrcode, @bitLen)
;assert(bitLen % 8 == 0);
; Pad With alternating bytes Until Data capacity is reached
;For (uint8_t padByte = 0xEC; bitLen < dataCapacityBits; padByte ^= 0xEC ^ 0x11)
padByte = $EC
While bitLen < dataCapacityBits
qrcodegen_internal_appendBitsToBuffer(padByte, 8, *qrcode, @bitLen)
;padByte = padByte ! ($EC ! $11)
If padByte = $EC
padByte = $11
Else
padByte = $EC
EndIf
Wend
; Draw function And Data codeword modules
qrcodegen_internal_addEccAndInterleave(*qrcode, version, ecl, *tempBuffer)
qrcodegen_internal_initializeFunctionModules(version, *qrcode)
qrcodegen_internal_drawCodewords(*tempBuffer, qrcodegen_internal_getNumRawDataModules(version) / 8, *qrcode)
qrcodegen_internal_drawWhiteFunctionModules(*qrcode, version)
qrcodegen_internal_initializeFunctionModules(version, *tempBuffer)
; Handle masking
If mask = #qrcodegen_Mask_AUTO ; Automatically choose best mask
minPenalty = #LONG_MAX
For i = #qrcodegen_Mask_0 To #qrcodegen_Mask_7
msk = i
qrcodegen_internal_applyMask(*tempBuffer, *qrcode, msk)
qrcodegen_internal_drawFormatBits(ecl, msk, *qrcode)
penalty = qrcodegen_internal_getPenaltyScore(*qrcode)
If penalty < minPenalty
mask = msk
minPenalty = penalty
EndIf
qrcodegen_internal_applyMask(*tempBuffer, *qrcode, msk) ; Undoes the mask due to XOR
Next i
EndIf
;assert(0 <= (int)mask && (int)mask <= 7);
qrcodegen_internal_applyMask(*tempBuffer, *qrcode, mask)
qrcodegen_internal_drawFormatBits(ecl, mask, *qrcode)
ProcedureReturn #True
EndProcedure
;---- Error correction code generation functions
; Appends error correction bytes To each block of the given Data Array, then interleaves
; bytes from the blocks And stores them in the result Array. Data[0 : dataLen] contains
; the input Data. Data[dataLen : rawCodewords] is used As a temporary work area And will
; be clobbered by this function. The final answer is stored in result[0 : rawCodewords].
Procedure qrcodegen_internal_addEccAndInterleave(*data.AsciiStructure, version.i, ecl.i, *result.AsciiStructure)
Protected numBlocks.i, blockEccLen.i, rawCodewords.i, dataLen.i, numShortBlocks.i, shortBlockDataLen.i
Protected *dat.AsciiStructure, i.i, j.i, k.i, *ecc.AsciiStructure, datLen.i
Protected *rsdiv.AsciiStructure
; Calculate parameter numbers
;assert(0 <= (int)ecl && (int)ecl < 4 && qrcodegen_VERSION_MIN <= version && version <= qrcodegen_VERSION_MAX);
numBlocks = PeekB(?qrcodegen_internal_NUM_ERROR_CORRECTION_BLOCKS + ecl * 41 + version)
blockEccLen = PeekB(?qrcodegen_internal_ECC_CODEWORDS_PER_BLOCK + ecl * 41 + version)
rawCodewords = qrcodegen_internal_getNumRawDataModules(version) / 8
dataLen = qrcodegen_internal_getNumDataCodewords(version, ecl)
numShortBlocks = numBlocks - rawCodewords % numBlocks
shortBlockDataLen = rawCodewords / numBlocks - blockEccLen
; Split Data into blocks, calculate ECC, And interleave
; (Not concatenate) the bytes into a single sequence
*rsdiv = AllocateMemory(#qrcodegen_REED_SOLOMON_DEGREE_MAX)
If *rsdiv
qrcodegen_internal_reedSolomonComputeDivisor(blockEccLen, *rsdiv)
*dat = *data
For i = 0 To numBlocks - 1
If i < numShortBlocks
datLen = shortBlockDataLen
Else
datLen = shortBlockDataLen + 1
EndIf
*ecc = @*data\a[dataLen] ; Temporary storage
qrcodegen_internal_reedSolomonComputeRemainder(*dat, datLen, *rsdiv, blockEccLen, *ecc);
k = i
For j = 0 To datLen - 1 ; Copy Data
If j = shortBlockDataLen
k - numShortBlocks
EndIf
*result\a[k] = *dat\a[j]
k + numBlocks
Next j
k = dataLen + i
For j = 0 To blockEccLen - 1 ; Copy ECC
*result\a[k] = *ecc\a[j]
k + numBlocks
Next j
*dat + datLen
Next i
FreeMemory(*rsdiv)
EndIf
EndProcedure
; Returns the number of 8-bit codewords that can be used For storing Data (Not ECC),
; For the given version number And error correction level. The result is in the range [9, 2956].
Procedure.i qrcodegen_internal_getNumDataCodewords(version.i, ecl.i)
Protected v.i, e.i
v = version
e = ecl
;assert(0 <= e && e < 4);
;ProcedureReturn qrcodegen_internal_getNumRawDataModules(v) / 8 - ECC_CODEWORDS_PER_BLOCK[e][v] * NUM_ERROR_CORRECTION_BLOCKS[e][v]
ProcedureReturn qrcodegen_internal_getNumRawDataModules(v) / 8 - PeekB(?qrcodegen_internal_ECC_CODEWORDS_PER_BLOCK + e * 41 + v) * PeekB(?qrcodegen_internal_NUM_ERROR_CORRECTION_BLOCKS + e * 41 + v)
EndProcedure
; Returns the number of Data bits that can be stored in a QR Code of the given version number, after
; all function modules are excluded. This includes remainder bits, so it might Not be a multiple of 8.
; The result is in the range [208, 29648]. This could be implemented As a 40-entry lookup table.
Procedure.i qrcodegen_internal_getNumRawDataModules(ver.i)
Protected result.i, numAlign.i
;assert(qrcodegen_VERSION_MIN <= ver && ver <= qrcodegen_VERSION_MAX);
result = (16 * ver + 128) * ver + 64
If ver >= 2
numAlign = ver / 7 + 2
result - ((25 * numAlign - 10) * numAlign - 55)
If ver >= 7
result - 36
EndIf
EndIf
;assert(208 <= result && result <= 29648);
ProcedureReturn result
EndProcedure
;---- Reed-Solomon ECC generator functions
; Computes a Reed-Solomon ECC generator polynomial For the given degree, storing in result[0 : degree].
; This could be implemented As a lookup table over all possible parameter values, instead of As an algorithm.
Procedure qrcodegen_internal_reedSolomonComputeDivisor(degree.i, *result.AsciiStructure)
Protected root.a, i.i, j.i
;assert(1 <= degree && degree <= qrcodegen_REED_SOLOMON_DEGREE_MAX);
; Polynomial coefficients are stored from highest To lowest power, excluding the leading term which is always 1.
; For example the polynomial x^3 + 255x^2 + 8x + 93 is stored As the uint8 Array {255, 8, 93}.
;memset(result, 0, (size_t)degree * SizeOf(result[0]));
FillMemory(*result, degree * 1, 0)
*result\a[degree - 1] = 1 ; Start off with the monomial x^0
; Compute the product polynomial (x - r^0) * (x - r^1) * (x - r^2) * ... * (x - r^{degree-1}),
; drop the highest monomial term which is always 1x^degree.
; Note that r = 0x02, which is a generator element of this field GF(2^8/0x11D).
root = 1
For i = 0 To degree - 1
; Multiply the current product by (x - r^i)
For j = 0 To degree - 1
*result\a[j] = qrcodegen_internal_reedSolomonMultiply(*result\a[j], root)
If j + 1 < degree
*result\a[j] = *result\a[j] ! *result\a[j + 1]
EndIf
Next j
root = qrcodegen_internal_reedSolomonMultiply(root, $02)
Next i
EndProcedure
; Computes the Reed-Solomon error correction codeword For the given Data And divisor polynomials.
; The remainder when Data[0 : dataLen] is divided by divisor[0 : degree] is stored in result[0 : degree].
; All polynomials are in big endian, And the generator has an implicit leading 1 term.
Procedure qrcodegen_internal_reedSolomonComputeRemainder(*data.AsciiStructure, dataLen.i, *generator.AsciiStructure, degree.i, *result.AsciiStructure)
Protected i.i, factor.a, j.i
;assert(1 <= degree && degree <= qrcodegen_REED_SOLOMON_DEGREE_MAX);
;memset(result, 0, (size_t)degree * SizeOf(result[0]));
FillMemory(*result, degree * 1, 0)
For i = 0 To dataLen - 1 ; Polynomial division
factor = *data\a[i] ! *result\a[0]
;memmove(&result[0], &result[1], (size_t)(degree - 1) * SizeOf(result[0]));
MoveMemory(@*result\a[1], @*result\a[0], (degree - 1) * 1)
*result\a[degree - 1] = 0
For j = 0 To degree - 1
*result\a[j] = *result\a[j] ! qrcodegen_internal_reedSolomonMultiply(*generator\a[j], factor)
Next j
Next i
EndProcedure
; Returns the product of the two given field elements modulo GF(2^8/0x11D).
; All inputs are valid. This could be implemented As a 256*256 lookup table.
Procedure.a qrcodegen_internal_reedSolomonMultiply(x.a, y.a)
Protected z.a, i.i
; Russian peasant multiplication
For i = 7 To 0 Step -1
z = (z << 1) ! ((z >> 7) * $11D)
z = z ! (((y >> i) & 1) * x)
Next i
ProcedureReturn z
EndProcedure
;---- Drawing function modules
; Clears the given QR Code grid With white modules For the given
; version's size, then marks every function module as black.
Procedure qrcodegen_internal_initializeFunctionModules(version.i, *qrcode.AsciiStructure)
Protected qrsize.i, numAlign.i, i.i, j.i
; Initialize QR Code
qrsize = version * 4 + 17
;memset(qrcode, 0, (size_t)((qrsize * qrsize + 7) / 8 + 1) * SizeOf(qrcode[0]));
FillMemory(*qrcode, ((qrsize * qrsize + 7) / 8 + 1) * 1, 0)
*qrcode\a[0] = qrsize
; Fill horizontal And vertical timing patterns
qrcodegen_internal_fillRectangle(6, 0, 1, qrsize, *qrcode)
qrcodegen_internal_fillRectangle(0, 6, qrsize, 1, *qrcode)
; Fill 3 finder patterns (all corners except bottom right) And format bits
qrcodegen_internal_fillRectangle(0, 0, 9, 9, *qrcode)
qrcodegen_internal_fillRectangle(qrsize - 8, 0, 8, 9, *qrcode)
qrcodegen_internal_fillRectangle(0, qrsize - 8, 9, 8, *qrcode)
; Fill numerous alignment patterns
;uint8_t alignPatPos[7];
Dim alignPatPos.a(7)
numAlign = qrcodegen_internal_getAlignmentPatternPositions(version, alignPatPos())
For i = 0 To numAlign - 1
For j = 0 To numAlign - 1
; Don't draw on the three finder corners
If Not ((i = 0 And j = 0) Or (i = 0 And j = numAlign - 1) Or (i = numAlign - 1 And j = 0))
qrcodegen_internal_fillRectangle(alignPatPos(i) - 2, alignPatPos(j) - 2, 5, 5, *qrcode)
EndIf
Next j
Next i
; Fill version blocks
If version >= 7
qrcodegen_internal_fillRectangle(qrsize - 11, 0, 3, 6, *qrcode)
qrcodegen_internal_fillRectangle(0, qrsize - 11, 6, 3, *qrcode)
EndIf
EndProcedure
; Draws white function modules And possibly some black modules onto the given QR Code, without changing
; non-function modules. This does Not draw the format bits. This requires all function modules To be previously
; marked black (namely by initializeFunctionModules()), because this may skip redrawing black function modules.
Procedure qrcodegen_internal_drawWhiteFunctionModules(*qrcode.AsciiStructure, version.i)
Protected qrsize.i, i.i, dx.i, dy.i, dist.i, numAlign.i, j.i, rem.i, bits.i, k.i
; Draw horizontal And vertical timing patterns
qrsize = qrcodegen_getSize(*qrcode)
For i = 7 To qrsize - 8 Step 2
qrcodegen_internal_setModule(*qrcode, 6, i, #False)
qrcodegen_internal_setModule(*qrcode, i, 6, #False)
Next i
; Draw 3 finder patterns (all corners except bottom right; overwrites some timing modules)
For dy = -4 To 4
For dx = -4 To 4
dist = Abs(dx)
If Abs(dy) > dist
dist = Abs(dy)
EndIf
If dist = 2 Or dist = 4
qrcodegen_internal_setModuleBounded(*qrcode, 3 + dx, 3 + dy, #False)
qrcodegen_internal_setModuleBounded(*qrcode, qrsize - 4 + dx, 3 + dy, #False)
qrcodegen_internal_setModuleBounded(*qrcode, 3 + dx, qrsize - 4 + dy, #False)
EndIf
Next dx
Next dy
; Draw numerous alignment patterns
Dim alignPatPos.a(7)
numAlign = qrcodegen_internal_getAlignmentPatternPositions(version, alignPatPos())
For i = 0 To numAlign - 1
For j = 0 To numAlign - 1
If (i = 0 And j = 0) Or (i = 0 And j = numAlign - 1) Or (i = numAlign - 1 And j = 0)
Continue; // Don't draw on the three finder corners
EndIf
For dy = -1 To 1
For dx = -1 To 1
qrcodegen_internal_setModule(*qrcode, alignPatPos(i) + dx, alignPatPos(j) + dy, Bool(dx = 0 And dy = 0))
Next dx
Next dy
Next j
Next i
; Draw version blocks
If version >= 7
; Calculate error correction code And pack bits
rem = version ; version is uint6, in the range [7, 40]
For i = 0 To 11
rem = (rem << 1) ! ((rem >> 11) * $1F25)
Next i
bits = version << 12 | rem; // uint18
;assert(bits >> 18 == 0);
; Draw two copies
For i = 0 To 5
For j = 0 To 2
k = qrsize - 11 + j
qrcodegen_internal_setModule(*qrcode, k, i, Bool((bits & 1) <> 0))
qrcodegen_internal_setModule(*qrcode, i, k, Bool((bits & 1) <> 0))
bits = bits >> 1
Next j
Next i
EndIf
EndProcedure
; Draws two copies of the format bits (With its own error correction code) based
; on the given mask And error correction level. This always draws all modules of
; the format bits, unlike drawWhiteFunctionModules() which might skip black modules.
Procedure qrcodegen_internal_drawFormatBits(ecl.i, mask.i, *qrcode.AsciiStructure)
Protected dataI.i, rem.i, i.i, bits.i, qrsize.i
Protected Dim table.i(3)
; Calculate error correction code And pack bits
;assert(0 <= (int)mask && (int)mask <= 7);
table(0) = 1
table(1) = 0
table(2) = 3
table(3) = 2
dataI = table(ecl) << 3 | mask ; errCorrLvl is uint2, mask is uint3
rem = dataI
For i = 0 To 9
rem = (rem << 1) ! ((rem >> 9) * $537)
Next i
bits = (dataI << 10 | rem) ! $5412 ; // uint15
;assert(bits >> 15 == 0);
; Draw first copy
For i = 0 To 5
qrcodegen_internal_setModule(*qrcode, 8, i, qrcodegen_internal_getBit(bits, i))
Next i
qrcodegen_internal_setModule(*qrcode, 8, 7, qrcodegen_internal_getBit(bits, 6))
qrcodegen_internal_setModule(*qrcode, 8, 8, qrcodegen_internal_getBit(bits, 7))
qrcodegen_internal_setModule(*qrcode, 7, 8, qrcodegen_internal_getBit(bits, 8))
For i = 9 To 14
qrcodegen_internal_setModule(*qrcode, 14 - i, 8, qrcodegen_internal_getBit(bits, i))
Next i
; Draw second copy
qrsize = qrcodegen_getSize(*qrcode)
For i = 0 To 7
qrcodegen_internal_setModule(*qrcode, qrsize - 1 - i, 8, qrcodegen_internal_getBit(bits, i))
Next i
For i = 8 To 14
qrcodegen_internal_setModule(*qrcode, 8, qrsize - 15 + i, qrcodegen_internal_getBit(bits, i))
Next i
qrcodegen_internal_setModule(*qrcode, 8, qrsize - 8, #True) ; // Always black
EndProcedure
; Calculates And stores an ascending List of positions of alignment patterns
; For this version number, returning the length of the List (in the range [0,7]).
; Each position is in the range [0,177), And are used on both the x And y axes.
; This could be implemented As lookup table of 40 variable-length lists of unsigned bytes.
Procedure.i qrcodegen_internal_getAlignmentPatternPositions(version.i, Array result.a(1))
Protected numAlign.i, Stepi.i, i.i, pos.i
If version <> 1
numAlign = version / 7 + 2
If version = 32
Stepi = 26
Else
Stepi = (version*4 + numAlign*2 + 1) / (numAlign*2 - 2) * 2
EndIf
;For (int i = numAlign - 1, pos = version * 4 + 10; i >= 1; i--, pos -= step)
pos = version * 4 + 10
For i = numAlign - 1 To 1 Step -1
result(i) = pos
pos - stepi
Next i
result(0) = 6
EndIf
ProcedureReturn numAlign
EndProcedure
; Sets every pixel in the range [left : left + width] * [top : top + height] to black.
Procedure qrcodegen_internal_fillRectangle(left.i, top.i, width.i, height.i, *qrcode.AsciiStructure)
Protected dy.i, dx.i
For dy = 0 To height - 1
For dx = 0 To width - 1
qrcodegen_internal_setModule(*qrcode, left + dx, top + dy, #True)
Next dx
Next dy
EndProcedure
;---- Drawing Data modules And masking
; Draws the raw codewords (including Data And ECC) onto the given QR Code. This requires the initial state of
; the QR Code To be black at function modules And white at codeword modules (including unused remainder bits).
Procedure qrcodegen_internal_drawCodewords(*data.AsciiStructure, dataLen.i, *qrcode.AsciiStructure)
Protected qrsize.i, i.i, right.i, vert.i, j.i, x.i, upward.i, y.i, black.i
qrsize = qrcodegen_getSize(*qrcode)
; Do the funny zigzag scan
For right = qrsize - 1 To 1 Step -2 ; Index of right column in each column pair
If right = 6
right = 5
EndIf
For vert = 0 To qrsize - 1 ; Vertical counter
For j = 0 To 1
x = right - j ; Actual x coordinate
upward = Bool((right + 1) & 2 = 0)
; Actual y coordinate
If upward
y = qrsize - 1 - vert
Else
y = vert
EndIf
If (Not qrcodegen_internal_getModule(*qrcode, x, y)) And i < dataLen * 8
black = qrcodegen_internal_getBit(*data\a[i >> 3], 7 - (i & 7))
qrcodegen_internal_setModule(*qrcode, x, y, black)
i + 1
EndIf
; If this QR Code has any remainder bits (0 To 7), they were assigned As
; 0/false/white by the constructor And are left unchanged by this method
Next j
Next vert
Next right
;assert(i == dataLen * 8);
EndProcedure
; XORs the codeword modules in this QR Code With the given mask pattern.
; The function modules must be marked And the codeword bits must be drawn
; before masking. Due To the arithmetic of XOr, calling applyMask() With
; the same mask value a second time will undo the mask. A final well-formed
; QR Code needs exactly one (Not zero, two, etc.) mask applied.
Procedure qrcodegen_internal_applyMask(*functionModules.AsciiStructure, *qrcode.AsciiStructure, mask.i)
Protected qrsize.i, x.i, y.i, invert.i, val.i
;assert(0 <= (int)mask && (int)mask <= 7); // Disallows qrcodegen_Mask_AUTO
qrsize = qrcodegen_getSize(*qrcode)
For y = 0 To qrsize - 1
For x = 0 To qrsize - 1
If qrcodegen_internal_getModule(*functionModules, x, y)
Continue
EndIf
Select mask
Case 0: invert = Bool((x + y) % 2 = 0)
Case 1: invert = Bool(y % 2 = 0)
Case 2: invert = Bool(x % 3 = 0)
Case 3: invert = Bool((x + y) % 3 = 0)
Case 4: invert = Bool((x / 3 + y / 2) % 2 = 0)
Case 5: invert = Bool((x * y) % 2 + (x * y) % 3 = 0)
Case 6: invert = Bool(((x * y) % 2 + (x * y) % 3) % 2 = 0)
Case 7: invert = Bool(((x + y) % 2 + (x * y) % 3) % 2 = 0)
Default:
;assert(false);
;Return ;
Break 2
EndSelect
val = qrcodegen_internal_getModule(*qrcode, x, y)
qrcodegen_internal_setModule(*qrcode, x, y, val ! invert)
Next x
Next y
EndProcedure
; Calculates And returns the penalty score based on state of the given QR Code's current modules.
; This is used by the automatic mask choice algorithm To find the mask pattern that yields the lowest score.
Procedure.i qrcodegen_internal_getPenaltyScore(*qrcode.AsciiStructure)
Protected qrsize.i, result.i, x.i, y.i, runColor.i, runX.i, runY.i, color.i, black.i, total.i, k.i
qrsize = qrcodegen_getSize(*qrcode)
; Adjacent modules in row having same color, And finder-like patterns
For y = 0 To qrsize - 1
runColor = #False
runX = 0
Dim runHistory.i(7)
For x = 0 To qrsize - 1
If qrcodegen_internal_getModule(*qrcode, x, y) = runColor
runX + 1
If runX = 5
result + #qrcodegen_PENALTY_N1
ElseIf runX > 5
result + 1
EndIf
Else
qrcodegen_internal_finderPenaltyAddHistory(runX, runHistory(), qrsize)
If Not runColor
result + qrcodegen_internal_finderPenaltyCountPatterns(runHistory(), qrsize) * #qrcodegen_PENALTY_N3
EndIf
runColor = qrcodegen_internal_getModule(*qrcode, x, y)
runX = 1
EndIf
Next x
result + qrcodegen_internal_finderPenaltyTerminateAndCount(runColor, runX, runHistory(), qrsize) * #qrcodegen_PENALTY_N3
Next y
; Adjacent modules in column having same color, And finder-like patterns
For x = 0 To qrsize - 1
runColor = #False
runY = 0
Dim runHistory.i(7)
For y = 0 To qrsize - 1
If qrcodegen_internal_getModule(*qrcode, x, y) = runColor
runY + 1
If runY = 5
result + #qrcodegen_PENALTY_N1
ElseIf runY > 5
result + 1
EndIf
Else
qrcodegen_internal_finderPenaltyAddHistory(runY, runHistory(), qrsize)
If Not runColor
result + qrcodegen_internal_finderPenaltyCountPatterns(runHistory(), qrsize) * #qrcodegen_PENALTY_N3
EndIf
runColor = qrcodegen_internal_getModule(*qrcode, x, y)
runY = 1
EndIf
Next y
result + qrcodegen_internal_finderPenaltyTerminateAndCount(runColor, runY, runHistory(), qrsize) * #qrcodegen_PENALTY_N3
Next x
; 2*2 blocks of modules having same color
For y = 0 To qrsize - 2
For x = 0 To qrsize - 2
color = qrcodegen_internal_getModule(*qrcode, x, y)
If color = qrcodegen_internal_getModule(*qrcode, x + 1, y) And color = qrcodegen_internal_getModule(*qrcode, x, y + 1) And color = qrcodegen_internal_getModule(*qrcode, x + 1, y + 1)
result + #qrcodegen_PENALTY_N2
EndIf
Next x
Next y
; Balance of black And white modules
black = 0
For y = 0 To qrsize - 1
For x = 0 To qrsize - 1
If qrcodegen_internal_getModule(*qrcode, x, y)
black + 1
EndIf
Next x
Next y
total = qrsize * qrsize ; Note that size is odd, so black/total != 1/2
; Compute the smallest integer k >= 0 such that (45-5k)% <= black/total <= (55+5k)%
k = Int((Abs(black * 20 - total * 10) + total - 1) / total) - 1
result + (k * #qrcodegen_PENALTY_N4)
ProcedureReturn result
EndProcedure
; Can only be called immediately after a white run is added, And
; returns either 0, 1, Or 2. A helper function For getPenaltyScore().
Procedure.i qrcodegen_internal_finderPenaltyCountPatterns(Array runHistory.i(1), qrsize.i)
Protected n.i, core.i, Result.i
n = runHistory(1)
;assert(n <= qrsize * 3);
core = Bool(n > 0 And runHistory(2) = n And runHistory(3) = n * 3 And runHistory(4) = n And runHistory(5) = n)
; The maximum QR Code size is 177, hence the black run length n <= 177.
; Arithmetic is promoted To int, so n*4 will Not overflow.
;Return (core && runHistory[0] >= n * 4 && runHistory[6] >= n ? 1 : 0) + (core && runHistory[6] >= n * 4 && runHistory[0] >= n ? 1 : 0);
If core And runHistory(0) >= n * 4 And runHistory(6) >= n
Result + 1
EndIf
If core And runHistory(6) >= n * 4 And runHistory(0) >= n
Result + 1
EndIf
ProcedureReturn Result
EndProcedure
; Must be called at the end of a line (row or column) of modules. A helper function for getPenaltyScore().
Procedure.i qrcodegen_internal_finderPenaltyTerminateAndCount(currentRunColor.i, currentRunLength.i, Array runHistory.i(1), qrsize.i)
If currentRunColor ; Terminate black run
qrcodegen_internal_finderPenaltyAddHistory(currentRunLength, runHistory(), qrsize)
currentRunLength = 0
EndIf
currentRunLength + qrsize; // Add white border to final run
qrcodegen_internal_finderPenaltyAddHistory(currentRunLength, runHistory(), qrsize)
ProcedureReturn qrcodegen_internal_finderPenaltyCountPatterns(runHistory(), qrsize)
EndProcedure
; Pushes the given value to the front and drops the last value. A helper function for getPenaltyScore().
Procedure qrcodegen_internal_finderPenaltyAddHistory(currentRunLength.i, Array runHistory.i(1), qrsize.i)
Protected i.i
If runHistory(0) = 0
currentRunLength + qrsize ; Add white border to initial run
EndIf
;memmove(&runHistory[1], &runHistory[0], 6 * SizeOf(runHistory[0]));
MoveMemory(@runHistory(0), @runHistory(1), 6 * SizeOf(Integer))
runHistory(0) = currentRunLength
EndProcedure
;---- Basic QR Code information
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_getSize(*qrcode.AsciiStructure)
Protected result.i
;assert(qrcode != NULL);
result = *qrcode\a[0]
;assert((qrcodegen_VERSION_MIN * 4 + 17) <= result && result <= (qrcodegen_VERSION_MAX * 4 + 17));
ProcedureReturn result
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_getModule(*qrcode.AsciiStructure, x.i, y.i)
Protected qrsize.i
;assert(qrcode != NULL);
qrsize = *qrcode\a[0]
ProcedureReturn Bool((0 <= x And x < qrsize And 0 <= y And y < qrsize) And qrcodegen_internal_getModule(*qrcode, x, y))
EndProcedure
; Gets the module at the given coordinates, which must be in bounds.
Procedure.i qrcodegen_internal_getModule(*qrcode.AsciiStructure, x.i, y.i)
Protected qrsize.i, index.i
qrsize = *qrcode\a[0]
;assert(21 <= qrsize && qrsize <= 177 && 0 <= x && x < qrsize && 0 <= y && y < qrsize);
index = y * qrsize + x
ProcedureReturn qrcodegen_internal_getBit(*qrcode\a[(index >> 3) + 1], index & 7)
EndProcedure
; Sets the module at the given coordinates, which must be in bounds.
Procedure qrcodegen_internal_setModule(*qrcode.AsciiStructure, x.i, y.i, isBlack.i)
Protected qrsize.i, index.i, bitIndex.i, byteIndex.i
qrsize = *qrcode\a[0]
;assert(21 <= qrsize && qrsize <= 177 && 0 <= x && x < qrsize && 0 <= y && y < qrsize);
index = y * qrsize + x
bitIndex = index & 7
byteIndex = (index >> 3) + 1
If isBlack
*qrcode\a[byteIndex] = *qrcode\a[byteIndex] | (1 << bitIndex)
Else
*qrcode\a[byteIndex] = *qrcode\a[byteIndex] & ((1 << bitIndex) ! $FF)
EndIf
EndProcedure
; Sets the module at the given coordinates, doing nothing if out of bounds.
Procedure qrcodegen_internal_setModuleBounded(*qrcode.AsciiStructure, x.i, y.i, isBlack.i)
Protected qrsize.i
qrsize = *qrcode\a[0]
If 0 <= x And x < qrsize And 0 <= y And y < qrsize
qrcodegen_internal_setModule(*qrcode, x, y, isBlack)
EndIf
EndProcedure
; Returns true iff the i'th bit of x is set to 1. Requires x >= 0 and 0 <= i <= 14.
Procedure.i qrcodegen_internal_getBit(x.i, i.i)
ProcedureReturn Bool(((x >> i) & 1) <> 0)
EndProcedure
;---- Segment handling
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_isAlphanumeric(*text.Character)
Protected Result.i
Result = #True
;assert(text != NULL);
While *text\c
If FindString(#qrcodegen_ALPHANUMERIC_CHARSET$, Chr(*text\c)) = 0
Result = #False
Break
EndIf
*text + 2
Wend
ProcedureReturn Result
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_isNumeric(*text.Character)
Protected Result.i
Result = #True
While *text\c
If *text\c < '0' Or *text\c > '9'
Result = #False
Break
EndIf
*text + 2
Wend
ProcedureReturn Result
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_calcSegmentBufferSize(mode.i, numChars.i)
Protected Result.i, temp.i
temp = qrcodegen_internal_calcSegmentBitLength(mode, numChars)
If temp = -1
Result = #SIZE_MAX
Else
;assert(0 <= temp && temp <= INT16_MAX)
Result = (temp + 7) / 8
EndIf
ProcedureReturn Result
EndProcedure
; Returns the number of Data bits needed To represent a segment
; containing the given number of characters using the given mode. Notes:
; - Returns -1 on failure, i.e. numChars > INT16_MAX Or
; the number of needed bits exceeds INT16_MAX (i.e. 32767).
; - Otherwise, all valid results are in the range [0, INT16_MAX].
; - For byte mode, numChars measures the number of bytes, Not Unicode code points.
; - For ECI mode, numChars must be 0, And the worst-Case number of bits is returned.
; An actual ECI segment can have shorter Data. For non-ECI modes, the result is exact.
Procedure.i qrcodegen_internal_calcSegmentBitLength(mode.i, numChars.i)
Protected result.i
; All calculations are designed To avoid overflow on all platforms
If numChars > #INT16_MAX
result = -1
Else
result = numChars
If mode = #qrcodegen_Mode_NUMERIC
result = (result * 10 + 2) / 3 ; ceil(10/3 * n)
ElseIf mode = #qrcodegen_Mode_ALPHANUMERIC
result = (result * 11 + 1) / 2 ; ceil(11/2 * n)
ElseIf mode = #qrcodegen_Mode_BYTE
result = result * 8
ElseIf mode = #qrcodegen_Mode_KANJI
result = result * 13
ElseIf mode = #qrcodegen_Mode_ECI And numChars = 0
result = 3 * 8
Else ; Invalid argument
;assert(false)
Result = -1
EndIf
;assert(result >= 0);
If result > #INT16_MAX
result = -1
EndIf
EndIf
ProcedureReturn result
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_makeBytes(*data.AsciiStructure, len.i, *buf.AsciiStructure)
Static result.qrcodegen_Segment
;assert(Data != NULL || len == 0)
result\mode = #qrcodegen_Mode_BYTE
result\bitLength = qrcodegen_internal_calcSegmentBitLength(result\mode, len)
;assert(result.bitLength != -1);
result\numChars = len
If len > 0
;memcpy(buf, Data, len * SizeOf(buf[0]));
CopyMemory(*data, *buf, len * 1)
EndIf
result\Data = *buf
ProcedureReturn @result
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_makeNumeric(digits$, *buf.AsciiStructure)
Protected len.i, bitLen.i, accumData.i, accumCount.i
Static result.qrcodegen_Segment
Protected *digits.Character
;assert(digits != NULL)
len = Len(digits$)
result\mode = #qrcodegen_Mode_NUMERIC
bitLen = qrcodegen_internal_calcSegmentBitLength(result\mode, len)
;assert(bitLen != -1)
result\numChars = len
If bitLen > 0
;memset(buf, 0, ((size_t)bitLen + 7) / 8 * SizeOf(buf[0]))
FillMemory(*buf, (bitLen + 7) / 8 * 1, 0)
EndIf
result\bitLength = 0
*digits = @digits$
While *digits\c
;assert('0' <= c && c <= '9');
accumData = accumData * 10 + (*digits\c - '0')
accumCount + 1
If accumCount = 3
qrcodegen_internal_appendBitsToBuffer(accumData, 10, *buf, @result\bitLength)
accumData = 0
accumCount = 0
EndIf
*digits + 2
Wend
If accumCount > 0 ; 1 Or 2 digits remaining
qrcodegen_internal_appendBitsToBuffer(accumData, accumCount * 3 + 1, *buf, @result\bitLength)
EndIf
;assert(result.bitLength == bitLen)
result\Data = *buf
ProcedureReturn @result
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_makeAlphanumeric(text$, *buf.AsciiStructure)
Protected len.i, bitLen.i, accumData.i, accumCount.i, temp.i
Static result.qrcodegen_Segment
Protected *text.Character
;assert(text != NULL);
len = Len(text$)
result\mode = #qrcodegen_Mode_ALPHANUMERIC
bitLen = qrcodegen_internal_calcSegmentBitLength(result\mode, len)
;assert(bitLen != -1);
result\numChars = len
If bitLen > 0
;memset(buf, 0, ((size_t)bitLen + 7) / 8 * SizeOf(buf[0]));
FillMemory(*buf, (bitLen + 7) / 8 * 1, 0)
EndIf
result\bitLength = 0
;For (; *text != '\0'; text++) {
*text = @text$
While *text\c
temp = FindString(#qrcodegen_ALPHANUMERIC_CHARSET$, Chr(*text\c))
;assert(temp != NULL);
accumData = accumData * 45 + temp - 1
accumCount + 1
If accumCount = 2
qrcodegen_internal_appendBitsToBuffer(accumData, 11, *buf, @result\bitLength)
accumData = 0
accumCount = 0
EndIf
*text + 2
Wend
If accumCount > 0 ; 1 character remaining
qrcodegen_internal_appendBitsToBuffer(accumData, 6, *buf, @result\bitLength)
EndIf
;assert(result.bitLength == bitLen);
result\Data = *buf
ProcedureReturn @result
EndProcedure
; Public function - see documentation comment in header file.
Procedure.i qrcodegen_makeEci(assignVal.i, *buf.AsciiStructure)
Static result.qrcodegen_Segment
result\mode = #qrcodegen_Mode_ECI
result\numChars = 0
result\bitLength = 0
If assignVal < 0
;assert(false);
ElseIf assignVal < (1 << 7)
;memset(buf, 0, 1 * SizeOf(buf[0]))
FillMemory(*buf, 1 * 1, 0)
qrcodegen_internal_appendBitsToBuffer(assignVal, 8, *buf, @result\bitLength)
ElseIf assignVal < (1 << 14)
;memset(buf, 0, 2 * SizeOf(buf[0]))
FillMemory(*buf, 2 * 1, 0)
qrcodegen_internal_appendBitsToBuffer(2, 2, *buf, @result\bitLength)
qrcodegen_internal_appendBitsToBuffer(assignVal, 14, *buf, @result\bitLength)
ElseIf assignVal < 1000000
;memset(buf, 0, 3 * SizeOf(buf[0]))
FillMemory(*buf, 3 * 1, 0)
qrcodegen_internal_appendBitsToBuffer(6, 3, *buf, @result\bitLength)
qrcodegen_internal_appendBitsToBuffer((assignVal >> 10), 11, *buf, @result\bitLength)
qrcodegen_internal_appendBitsToBuffer((assignVal & $3FF), 10, *buf, @result\bitLength)
Else
;assert(false);
EndIf
result\Data = *buf
ProcedureReturn @result
EndProcedure
; Calculates the number of bits needed To encode the given segments at the given version.
; Returns a non-negative number If successful. Otherwise returns -1 If a segment has too
; many characters To fit its length field, Or the total bits exceeds INT16_MAX.
Procedure.i qrcodegen_internal_getTotalBits(Array segs.qrcodegen_Segment(1), len.i, version.i)
Protected i.i, result.i, numChars.i, bitLength.i, ccbits.i
;assert(segs != NULL || len == 0);
For i = 0 To len - 1
numChars = segs(i)\numChars
bitLength = segs(i)\bitLength
;assert(0 <= numChars && numChars <= INT16_MAX);
;assert(0 <= bitLength && bitLength <= INT16_MAX);
ccbits = qrcodegen_internal_numCharCountBits(segs(i)\mode, version)
;assert(0 <= ccbits && ccbits <= 16);
If numChars >= (1 << ccbits)
result = -1 ; The segment's length doesn't fit the field's bit width
Break
EndIf
result + 4 + ccbits + bitLength
If result > #INT16_MAX
result = -1 ; The sum might overflow an int type
Break
EndIf
Next i
;assert(0 <= result && result <= INT16_MAX);
ProcedureReturn result
EndProcedure
; Returns the bit width of the character count field For a segment in the given mode
; in a QR Code at the given version number. The result is in the range [0, 16].
Procedure.i qrcodegen_internal_numCharCountBits(mode.i, version.i)
Protected i.i, Result.i
;assert(qrcodegen_VERSION_MIN <= version && version <= qrcodegen_VERSION_MAX);
i = (version + 7) / 17
Select mode
Case #qrcodegen_Mode_NUMERIC
Select i
Case 0 : Result = 10
Case 1 : Result = 12
Case 2 : Result = 14
Default : Result = -1
EndSelect
Case #qrcodegen_Mode_ALPHANUMERIC
Select i
Case 0 : Result = 9
Case 1 : Result = 11
Case 2 : Result = 13
Default : Result = -1
EndSelect
Case #qrcodegen_Mode_BYTE
Select i
Case 0 : Result = 8
Case 1 : Result = 16
Case 2 : Result = 16
Default : Result = -1
EndSelect
Case #qrcodegen_Mode_KANJI
Select i
Case 0 : Result = 8
Case 1 : Result = 10
Case 2 : Result = 12
Default : Result = -1
EndSelect
Case #qrcodegen_Mode_ECI
Result = 0
Default:
;assert(false);
Result = -1 ; // Dummy value
EndSelect
ProcedureReturn Result
EndProcedure
;-For PureBasic
; TargetSize : taille maximale souhaitée en pixels (0 = 1 pixel par module)
; -> le module est agrandi d'un facteur ENTIER, l'image fait <= TargetSize
; (sauf si même 1 pixel par module dépasse TargetSize)
; QuietZone : marge blanche en modules, incluse dans l'image (4 = valeur de la norme)
; Texte : numérique / alphanumérique QR -> mode compact, sinon UTF-8 (accents OK)
; Retour : image #PB_Any (à libérer par l'appelant) ou 0 en cas d'échec
Procedure.i Get_BarcodeQRCODE(Text$, color = #Black, backcolor = #White, TargetSize.i = 0, QuietZone.i = 4, ErrCorLvl.i=#qrcodegen_Ecc_LOW, BoostEcl.i=#True, MinVersion.i=#qrcodegen_VERSION_MIN, MaxVersion.i=#qrcodegen_VERSION_MAX, Mask.i=#qrcodegen_Mask_AUTO)
Protected.i bufferLen, qrsize, x, y, img, ok, dataLen, scale, fullSize
Protected *qrcode, *tempBuffer
If Text$ = #Null$
ProcedureReturn 0
EndIf
If QuietZone < 0
QuietZone = 0
EndIf
bufferLen = qrcodegen_BUFFER_LEN_FOR_VERSION(MaxVersion)
*qrcode = AllocateMemory(bufferLen)
*tempBuffer = AllocateMemory(bufferLen)
If *qrcode And *tempBuffer
If qrcodegen_isNumeric(@Text$) Or qrcodegen_isAlphanumeric(@Text$)
; Modes compacts (chiffres seuls, ou majuscules/chiffres/espace $%*+-./:)
ok = qrcodegen_encodeText(Text$, *tempBuffer, *qrcode, ErrCorLvl, MinVersion, MaxVersion, Mask, BoostEcl)
Else
; Mode octet en UTF-8 (lu correctement par les téléphones)
dataLen = StringByteLength(Text$, #PB_UTF8)
If dataLen > 0 And dataLen <= bufferLen
PokeS(*tempBuffer, Text$, -1, #PB_UTF8 | #PB_String_NoZero)
ok = qrcodegen_encodeBinary(*tempBuffer, dataLen, *qrcode, ErrCorLvl, MinVersion, MaxVersion, Mask, BoostEcl)
EndIf
EndIf
If ok
qrsize = qrcodegen_getSize(*qrcode)
If qrsize > 0
scale = 1
If TargetSize > 0
scale = TargetSize / (qrsize + QuietZone * 2) ; division entière
If scale < 1
scale = 1
EndIf
EndIf
fullSize = (qrsize + QuietZone * 2) * scale
img = CreateImage(#PB_Any, fullSize, fullSize, 24, backcolor)
If img
If StartDrawing(ImageOutput(img))
For y = 0 To qrsize - 1
For x = 0 To qrsize - 1
If qrcodegen_getModule(*qrcode, x, y)
Box((x + QuietZone) * scale, (y + QuietZone) * scale, scale, scale, color)
EndIf
Next x
Next y
StopDrawing()
EndIf
EndIf
EndIf
EndIf
EndIf
If *tempBuffer : FreeMemory(*tempBuffer) : EndIf
If *qrcode : FreeMemory(*qrcode) : EndIf
ProcedureReturn img
EndProcedure
;
; DataMatrix ECC200 (ISO/IEC 16022) - encodage ASCII
;
; Algorithmes : sélection du symbole, Reed-Solomon GF(256)/$12D, placement "Utah"
; et assemblage des motifs de repérage, d'après la norme et l'implémentation ZXing.
;
; 2026-10-12 première version (KoakDesign / co-dev Claude)
;
; Texte :
; - caractères <= 255 : encodés en ISO-8859-1 (jeu par défaut de la norme, accents français OK)
; - au moins un caractère > 255 (emoji...) : UTF-8 précédé d'un ECI 26 (UTF-8)
; - paires de chiffres compactées (1 codeword pour 2 chiffres)
;
DisableASM
CompilerIf Not #PB_Compiler_EnableExplicit
EnableExplicit
CompilerEndIf
Structure DM_Place
numrows.i
numcols.i
Array bits.b(0) ; -1 = non placé, 0 = clair, 1 = foncé
Array cw.a(0) ; codewords (données + correction)
EndStructure
#DM_SYMBOL_COUNT = 30
DataSection
DM_SymbolTable:
; rect, données, correction, largeur région, hauteur région, nb régions, nb blocs, correction/bloc
Data.l 0, 3, 5, 8, 8, 1, 1, 5 ; 10x10
Data.l 0, 5, 7, 10, 10, 1, 1, 7 ; 12x12
Data.l 1, 5, 7, 16, 6, 1, 1, 7 ; 8x18
Data.l 0, 8, 10, 12, 12, 1, 1, 10 ; 14x14
Data.l 1, 10, 11, 14, 6, 2, 1, 11 ; 8x32
Data.l 0, 12, 12, 14, 14, 1, 1, 12 ; 16x16
Data.l 1, 16, 14, 24, 10, 1, 1, 14 ; 12x26
Data.l 0, 18, 14, 16, 16, 1, 1, 14 ; 18x18
Data.l 0, 22, 18, 18, 18, 1, 1, 18 ; 20x20
Data.l 1, 22, 18, 16, 10, 2, 1, 18 ; 12x36
Data.l 0, 30, 20, 20, 20, 1, 1, 20 ; 22x22
Data.l 1, 32, 24, 16, 14, 2, 1, 24 ; 16x36
Data.l 0, 36, 24, 22, 22, 1, 1, 24 ; 24x24
Data.l 0, 44, 28, 24, 24, 1, 1, 28 ; 26x26
Data.l 1, 49, 28, 22, 14, 2, 1, 28 ; 16x48
Data.l 0, 62, 36, 14, 14, 4, 1, 36 ; 32x32
Data.l 0, 86, 42, 16, 16, 4, 1, 42 ; 36x36
Data.l 0, 114, 48, 18, 18, 4, 1, 48 ; 40x40
Data.l 0, 144, 56, 20, 20, 4, 1, 56 ; 44x44
Data.l 0, 174, 68, 22, 22, 4, 1, 68 ; 48x48
Data.l 0, 204, 84, 24, 24, 4, 2, 42 ; 52x52
Data.l 0, 280, 112, 14, 14, 16, 2, 56 ; 64x64
Data.l 0, 368, 144, 16, 16, 16, 4, 36 ; 72x72
Data.l 0, 456, 192, 18, 18, 16, 4, 48 ; 80x80
Data.l 0, 576, 224, 20, 20, 16, 4, 56 ; 88x88
Data.l 0, 696, 272, 22, 22, 16, 4, 68 ; 96x96
Data.l 0, 816, 336, 24, 24, 16, 6, 56 ; 104x104
Data.l 0, 1050, 408, 18, 18, 36, 6, 68 ; 120x120
Data.l 0, 1304, 496, 20, 20, 36, 8, 62 ; 132x132
Data.l 0, 1558, 620, 22, 22, 36, 10, 62 ; 144x144
EndDataSection
; ****************************************************************************
;- Reed-Solomon GF(256), polynôme $12D, racines alpha^1..alpha^n
Procedure.i dm_gfMul(x.i, y.i)
Protected z.i, i.i
For i = 7 To 0 Step -1
z = (z << 1) ! ((z >> 7) * $12D)
z = z ! (((y >> i) & 1) * x)
Next i
ProcedureReturn z & $FF
EndProcedure
; Polynôme générateur (sans le terme de tête), du degré le plus haut au plus bas
Procedure dm_rsDivisor(degree.i, Array gen.a(1))
Protected root.i, i.i, j.i
For i = 0 To degree - 1
gen(i) = 0
Next i
gen(degree - 1) = 1
root = 2 ; alpha^1
For i = 0 To degree - 1
For j = 0 To degree - 1
gen(j) = dm_gfMul(gen(j), root)
If j + 1 < degree
gen(j) = gen(j) ! gen(j + 1)
EndIf
Next j
root = dm_gfMul(root, 2)
Next i
EndProcedure
; Reste de la division : codewords de correction, du plus haut au plus bas
Procedure dm_rsRemainder(Array dat.a(1), dataLen.i, Array gen.a(1), degree.i, Array res.a(1))
Protected i.i, j.i, factor.i
For j = 0 To degree - 1
res(j) = 0
Next j
For i = 0 To dataLen - 1
factor = dat(i) ! res(0)
For j = 0 To degree - 2
res(j) = res(j + 1)
Next j
res(degree - 1) = 0
For j = 0 To degree - 1
res(j) = res(j) ! dm_gfMul(gen(j), factor)
Next j
Next i
EndProcedure
; ****************************************************************************
;- Placement des bits (algorithme "Utah" de la norme)
Procedure.i dm_hasBit(*p.DM_Place, col.i, row.i)
ProcedureReturn Bool(*p\bits(row * *p\numcols + col) >= 0)
EndProcedure
Procedure dm_module(*p.DM_Place, row.i, col.i, pos.i, bit.i)
Protected v.i
If row < 0
row = row + *p\numrows
col = col + 4 - ((*p\numrows + 4) % 8)
EndIf
If col < 0
col = col + *p\numcols
row = row + 4 - ((*p\numcols + 4) % 8)
EndIf
If row >= 0 And row < *p\numrows And col >= 0 And col < *p\numcols
If pos <= ArraySize(*p\cw())
v = *p\cw(pos)
EndIf
*p\bits(row * *p\numcols + col) = Bool((v & (1 << (8 - bit))) <> 0)
EndIf
EndProcedure
Procedure dm_utah(*p.DM_Place, row.i, col.i, pos.i)
dm_module(*p, row - 2, col - 2, pos, 1)
dm_module(*p, row - 2, col - 1, pos, 2)
dm_module(*p, row - 1, col - 2, pos, 3)
dm_module(*p, row - 1, col - 1, pos, 4)
dm_module(*p, row - 1, col, pos, 5)
dm_module(*p, row, col - 2, pos, 6)
dm_module(*p, row, col - 1, pos, 7)
dm_module(*p, row, col, pos, 8)
EndProcedure
Procedure dm_corner1(*p.DM_Place, pos.i)
Protected nr.i = *p\numrows, nc.i = *p\numcols
dm_module(*p, nr - 1, 0, pos, 1)
dm_module(*p, nr - 1, 1, pos, 2)
dm_module(*p, nr - 1, 2, pos, 3)
dm_module(*p, 0, nc - 2, pos, 4)
dm_module(*p, 0, nc - 1, pos, 5)
dm_module(*p, 1, nc - 1, pos, 6)
dm_module(*p, 2, nc - 1, pos, 7)
dm_module(*p, 3, nc - 1, pos, 8)
EndProcedure
Procedure dm_corner2(*p.DM_Place, pos.i)
Protected nr.i = *p\numrows, nc.i = *p\numcols
dm_module(*p, nr - 3, 0, pos, 1)
dm_module(*p, nr - 2, 0, pos, 2)
dm_module(*p, nr - 1, 0, pos, 3)
dm_module(*p, 0, nc - 4, pos, 4)
dm_module(*p, 0, nc - 3, pos, 5)
dm_module(*p, 0, nc - 2, pos, 6)
dm_module(*p, 0, nc - 1, pos, 7)
dm_module(*p, 1, nc - 1, pos, 8)
EndProcedure
Procedure dm_corner3(*p.DM_Place, pos.i)
Protected nr.i = *p\numrows, nc.i = *p\numcols
dm_module(*p, nr - 3, 0, pos, 1)
dm_module(*p, nr - 2, 0, pos, 2)
dm_module(*p, nr - 1, 0, pos, 3)
dm_module(*p, 0, nc - 2, pos, 4)
dm_module(*p, 0, nc - 1, pos, 5)
dm_module(*p, 1, nc - 1, pos, 6)
dm_module(*p, 2, nc - 1, pos, 7)
dm_module(*p, 3, nc - 1, pos, 8)
EndProcedure
Procedure dm_corner4(*p.DM_Place, pos.i)
Protected nr.i = *p\numrows, nc.i = *p\numcols
dm_module(*p, nr - 1, 0, pos, 1)
dm_module(*p, nr - 1, nc - 1, pos, 2)
dm_module(*p, 0, nc - 3, pos, 3)
dm_module(*p, 0, nc - 2, pos, 4)
dm_module(*p, 0, nc - 1, pos, 5)
dm_module(*p, 1, nc - 3, pos, 6)
dm_module(*p, 1, nc - 2, pos, 7)
dm_module(*p, 1, nc - 1, pos, 8)
EndProcedure
Procedure dm_place(*p.DM_Place)
Protected pos.i = 0, row.i = 4, col.i = 0
Protected nr.i = *p\numrows, nc.i = *p\numcols
Repeat
; cas particuliers des coins
If row = nr And col = 0
dm_corner1(*p, pos) : pos + 1
EndIf
If row = nr - 2 And col = 0 And nc % 4 <> 0
dm_corner2(*p, pos) : pos + 1
EndIf
If row = nr - 2 And col = 0 And nc % 8 = 4
dm_corner3(*p, pos) : pos + 1
EndIf
If row = nr + 4 And col = 2 And nc % 8 = 0
dm_corner4(*p, pos) : pos + 1
EndIf
; diagonale montante
Repeat
If row >= 0 And row < nr And col >= 0 And col < nc
If Not dm_hasBit(*p, col, row)
dm_utah(*p, row, col, pos) : pos + 1
EndIf
EndIf
row = row - 2
col = col + 2
Until row < 0 Or col >= nc
row = row + 1
col = col + 3
; diagonale descendante
Repeat
If row >= 0 And row < nr And col >= 0 And col < nc
If Not dm_hasBit(*p, col, row)
dm_utah(*p, row, col, pos) : pos + 1
EndIf
EndIf
row = row + 2
col = col - 2
Until row >= nr Or col < 0
row = row + 3
col = col + 1
Until row >= nr And col >= nc
; motif fixe en bas à droite si la zone n'a pas été remplie
If Not dm_hasBit(*p, nc - 1, nr - 1)
*p\bits((nr - 1) * nc + nc - 1) = 1
*p\bits((nr - 2) * nc + nc - 2) = 1
EndIf
EndProcedure
; ****************************************************************************
;- Procédure principale
; TargetSize : taille maximale souhaitée en pixels (plus grand côté, 0 = 1 pixel par module)
; -> le module est agrandi d'un facteur ENTIER
; QuietZone : marge blanche en modules, incluse dans l'image (norme : 1 minimum)
; Shape : #DM_SHAPE_SQUARE (défaut), #DM_SHAPE_RECTANGLE (carré si trop long), #DM_SHAPE_AUTO
; MaxSize : taille maximale du symbole en modules (plus grand côté), 0 = pas de limite
; ex. 32 -> au plus 32x32 (2x2 cases) ; si le texte ne tient pas : retour 0
; Retour : image #PB_Any (à libérer par l'appelant) ou 0 en cas d'échec
Procedure.i Get_BarcodeDATAMATRIX(Text.s, color = #Black, backcolor = #White, TargetSize.i = 0, QuietZone.i = 2, Shape.i = #DM_SHAPE_SQUARE, MaxSize.i = 0)
Protected *mem
Protected.i i, k, pass, n, byteLen, count, useUTF8, b1, b2, ok, found, img, symW, symH
Protected.i rect, dcap, ecap, regW, regH, regions, blocks, eccPB
Protected.i s_dcap, s_ecap, s_regW, s_regH, s_regions, s_blocks, s_eccPB
Protected.i total, pr, padv, bl, d, e, hR, vR, dataW, dataH, W, H, x, y, mX, mY
Protected.i maxDim, scale, imgW, imgH
Protected *c.Character
Protected place.DM_Place
If Text = #Null$
ProcedureReturn 0
EndIf
If QuietZone < 0
QuietZone = 0
EndIf
; --- 1. Texte -> octets (ISO-8859-1, ou UTF-8 si caractère > 255)
n = Len(Text)
*c = @Text
While *c\c
If *c\c > 255
useUTF8 = #True
Break
EndIf
*c + SizeOf(Character)
Wend
If useUTF8
byteLen = StringByteLength(Text, #PB_UTF8)
Dim bytes.a(byteLen)
*mem = AllocateMemory(byteLen + 1)
If *mem = 0
ProcedureReturn 0
EndIf
PokeS(*mem, Text, -1, #PB_UTF8 | #PB_String_NoZero)
For i = 0 To byteLen - 1
bytes(i) = PeekA(*mem + i)
Next i
FreeMemory(*mem)
Else
byteLen = n
Dim bytes.a(byteLen)
*c = @Text
For i = 0 To byteLen - 1
bytes(i) = *c\c & $FF
*c + SizeOf(Character)
Next i
EndIf
; --- 2. Octets -> codewords (mode ASCII)
Dim cw.a(byteLen * 2 + 4)
count = 0
If useUTF8
cw(count) = 241 : count + 1 ; ECI
cw(count) = 27 : count + 1 ; ECI 26 (UTF-8) -> valeur + 1
EndIf
i = 0
While i < byteLen
b1 = bytes(i)
b2 = -1
If i + 1 < byteLen
b2 = bytes(i + 1)
EndIf
If b1 >= '0' And b1 <= '9' And b2 >= '0' And b2 <= '9'
cw(count) = 130 + (b1 - '0') * 10 + (b2 - '0') : count + 1
i + 2
ElseIf b1 < 128
cw(count) = b1 + 1 : count + 1
i + 1
Else
cw(count) = 235 : count + 1 ; Upper Shift
cw(count) = b1 - 128 + 1 : count + 1
i + 1
EndIf
Wend
; --- 3. Choix du plus petit symbole qui contient les données
found = #False
For pass = 0 To 1
Restore DM_SymbolTable
For k = 0 To #DM_SYMBOL_COUNT - 1
Read.l rect : Read.l dcap : Read.l ecap : Read.l regW
Read.l regH : Read.l regions : Read.l blocks : Read.l eccPB
Select Shape
Case #DM_SHAPE_SQUARE
ok = Bool(rect = 0)
Case #DM_SHAPE_RECTANGLE
If pass = 0
ok = Bool(rect = 1)
Else
ok = Bool(rect = 0) ; 2e passe : repli sur les carrés
EndIf
Default
ok = #True
EndSelect
; taille maximale autorisée (en modules)
If ok And MaxSize > 0
Select regions
Case 1 : symW = regW + 2 : symH = regH + 2
Case 2 : symW = 2 * (regW + 2) : symH = regH + 2
Case 4 : symW = 2 * (regW + 2) : symH = 2 * (regH + 2)
Case 16 : symW = 4 * (regW + 2) : symH = 4 * (regH + 2)
Case 36 : symW = 6 * (regW + 2) : symH = 6 * (regH + 2)
EndSelect
If symW > MaxSize Or symH > MaxSize
ok = #False
EndIf
EndIf
If ok And dcap >= count
s_dcap = dcap : s_ecap = ecap : s_regW = regW : s_regH = regH
s_regions = regions : s_blocks = blocks : s_eccPB = eccPB
found = #True
Break
EndIf
Next k
If found Or Shape <> #DM_SHAPE_RECTANGLE
Break
EndIf
Next pass
If Not found
ProcedureReturn 0 ; texte trop long
EndIf
; --- 4. Remplissage (pad 129 puis pads "randomisés 253")
total = s_dcap + s_ecap
ReDim cw.a(total - 1)
If count < s_dcap
cw(count) = 129 : count + 1
While count < s_dcap
pr = ((149 * (count + 1)) % 253) + 1
padv = 129 + pr
If padv > 254
padv - 254
EndIf
cw(count) = padv : count + 1
Wend
EndIf
; --- 5. Correction d'erreurs Reed-Solomon (blocs entrelacés)
Dim gen.a(s_eccPB - 1)
Dim res.a(s_eccPB - 1)
Dim blk.a(s_dcap)
dm_rsDivisor(s_eccPB, gen())
For k = 0 To s_blocks - 1
bl = 0
d = k
While d < s_dcap
blk(bl) = cw(d) : bl + 1
d + s_blocks
Wend
dm_rsRemainder(blk(), bl, gen(), s_eccPB, res())
For e = 0 To s_eccPB - 1
cw(s_dcap + k + e * s_blocks) = res(e)
Next e
Next k
; --- 6. Placement des bits dans la zone de données
Select s_regions
Case 1 : hR = 1 : vR = 1
Case 2 : hR = 2 : vR = 1
Case 4 : hR = 2 : vR = 2
Case 16 : hR = 4 : vR = 4
Case 36 : hR = 6 : vR = 6
EndSelect
dataW = hR * s_regW
dataH = vR * s_regH
place\numrows = dataH
place\numcols = dataW
Dim place\bits(dataW * dataH - 1)
For i = 0 To dataW * dataH - 1
place\bits(i) = -1
Next i
Dim place\cw(total - 1)
For i = 0 To total - 1
place\cw(i) = cw(i)
Next i
dm_place(@place)
; --- 7. Assemblage : régions + motifs de repérage (L plein + bords pointillés)
W = dataW + 2 * hR
H = dataH + 2 * vR
Dim grid.a(W * H - 1)
mY = 0
For y = 0 To dataH - 1
If y % s_regH = 0 ; bord haut pointillé
For x = 0 To W - 1
grid(mY * W + x) = Bool(x % 2 = 0)
Next x
mY + 1
EndIf
mX = 0
For x = 0 To dataW - 1
If x % s_regW = 0 ; bord gauche plein
grid(mY * W + mX) = 1 : mX + 1
EndIf
grid(mY * W + mX) = Bool(place\bits(y * dataW + x) > 0) : mX + 1
If x % s_regW = s_regW - 1 ; bord droit pointillé
grid(mY * W + mX) = Bool(y % 2 = 0) : mX + 1
EndIf
Next x
mY + 1
If y % s_regH = s_regH - 1 ; bord bas plein
For x = 0 To W - 1
grid(mY * W + x) = 1
Next x
mY + 1
EndIf
Next y
; --- 8. Image à l'échelle entière, marge incluse
maxDim = W
If H > maxDim
maxDim = H
EndIf
maxDim + QuietZone * 2
scale = 1
If TargetSize > 0
scale = TargetSize / maxDim ; division entière
If scale < 1
scale = 1
EndIf
EndIf
imgW = (W + QuietZone * 2) * scale
imgH = (H + QuietZone * 2) * scale
img = CreateImage(#PB_Any, imgW, imgH, 24, backcolor)
If img
If StartDrawing(ImageOutput(img))
For y = 0 To H - 1
For x = 0 To W - 1
If grid(y * W + x)
Box((x + QuietZone) * scale, (y + QuietZone) * scale, scale, scale, color)
EndIf
Next x
Next y
StopDrawing()
EndIf
EndIf
ProcedureReturn img
EndProcedure
;
; PDF417 (ISO/IEC 15438) - compaction texte / octets / numérique, correction Reed-Solomon GF(929)
;
; Tables des motifs de barres (3 clusters x 929) reprises de pdf417gen (licence MIT).
; Logique vérifiée par un portage Python décodé avec zxing-cpp.
;
; 2026-10-12 première version (KoakDesign / co-dev Claude)
;
; Texte :
; - ASCII uniquement : compaction texte (2 caractères par codeword),
; numérique pour les suites de 13 chiffres et plus, octets pour le reste
; - au moins un caractère > 127 (accents, emoji) : UTF-8 précédé d'un ECI 26
;
DisableASM
CompilerIf Not #PB_Compiler_EnableExplicit
EnableExplicit
CompilerEndIf
#PDF_START = $1FEA8 ; motif de départ (17 modules)
#PDF_STOP = $3FA29 ; motif d'arrêt (18 modules)
#PDF_CLASS_TEXT = 0
#PDF_CLASS_BYTE = 1
#PDF_CLASS_NUMERIC = 2
DataSection
PDF_TextTable: ; [sous-mode 0..3][octet 0..127] -> index dans le sous-mode, 255 = absent
Data.a 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 26, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 255, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 255, 255, 255, 255, 255
Data.a 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 26, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 255, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 255, 255, 255, 255, 255
Data.a 255, 255, 255, 255, 255, 255, 255, 255, 255, 12, 255, 255, 255, 11, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 26, 255, 255, 15, 18, 21, 10, 255, 255, 255, 22, 20, 13, 16, 17, 19, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 14, 255, 255, 23, 255, 255
Data.a 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 24, 255
Data.a 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 255, 255, 255, 255, 255, 255, 255, 255, 255, 12, 15, 255, 255, 11, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255
Data.a 255, 10, 20, 255, 18, 255, 255, 28, 23, 24, 22, 255, 13, 16, 17, 19, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 14, 0, 1, 255, 2, 25
Data.a 3, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 4, 5, 6, 255, 7
Data.a 8, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 26, 21, 27, 9, 255
PDF_Codes: ; [cluster 0..2][codeword 0..928] -> motif 17 modules (bit 16 = 1er module, 1 = barre)
; cluster 0 (lignes 0, 3, 6...)
Data.l $1D5C0, $1EAF0, $1F57C, $1D4E0, $1EA78, $1F53E, $1A8C0, $1D470, $1A860, $15040, $1A830, $15020
Data.l $1ADC0, $1D6F0, $1EB7C, $1ACE0, $1D678, $1EB3E, $158C0, $1AC70, $15860, $15DC0, $1AEF0, $1D77C
Data.l $15CE0, $1AE78, $1D73E, $15C70, $1AE3C, $15EF0, $1AF7C, $15E78, $1AF3E, $15F7C, $1F5FA, $1D2E0
Data.l $1E978, $1F4BE, $1A4C0, $1D270, $1E93C, $1A460, $1D238, $14840, $1A430, $1D21C, $14820, $1A418
Data.l $14810, $1A6E0, $1D378, $1E9BE, $14CC0, $1A670, $1D33C, $14C60, $1A638, $1D31E, $14C30, $1A61C
Data.l $14EE0, $1A778, $1D3BE, $14E70, $1A73C, $14E38, $1A71E, $14F78, $1A7BE, $14F3C, $14F1E, $1A2C0
Data.l $1D170, $1E8BC, $1A260, $1D138, $1E89E, $14440, $1A230, $1D11C, $14420, $1A218, $14410, $14408
Data.l $146C0, $1A370, $1D1BC, $14660, $1A338, $1D19E, $14630, $1A31C, $14618, $1460C, $14770, $1A3BC
Data.l $14738, $1A39E, $1471C, $147BC, $1A160, $1D0B8, $1E85E, $14240, $1A130, $1D09C, $14220, $1A118
Data.l $1D08E, $14210, $1A10C, $14208, $1A106, $14360, $1A1B8, $1D0DE, $14330, $1A19C, $14318, $1A18E
Data.l $1430C, $14306, $1A1DE, $1438E, $14140, $1A0B0, $1D05C, $14120, $1A098, $1D04E, $14110, $1A08C
Data.l $14108, $1A086, $14104, $141B0, $14198, $1418C, $140A0, $1D02E, $1A04C, $1A046, $14082, $1CAE0
Data.l $1E578, $1F2BE, $194C0, $1CA70, $1E53C, $19460, $1CA38, $1E51E, $12840, $19430, $12820, $196E0
Data.l $1CB78, $1E5BE, $12CC0, $19670, $1CB3C, $12C60, $19638, $12C30, $12C18, $12EE0, $19778, $1CBBE
Data.l $12E70, $1973C, $12E38, $12E1C, $12F78, $197BE, $12F3C, $12FBE, $1DAC0, $1ED70, $1F6BC, $1DA60
Data.l $1ED38, $1F69E, $1B440, $1DA30, $1ED1C, $1B420, $1DA18, $1ED0E, $1B410, $1DA0C, $192C0, $1C970
Data.l $1E4BC, $1B6C0, $19260, $1C938, $1E49E, $1B660, $1DB38, $1ED9E, $16C40, $12420, $19218, $1C90E
Data.l $16C20, $1B618, $16C10, $126C0, $19370, $1C9BC, $16EC0, $12660, $19338, $1C99E, $16E60, $1B738
Data.l $1DB9E, $16E30, $12618, $16E18, $12770, $193BC, $16F70, $12738, $1939E, $16F38, $1B79E, $16F1C
Data.l $127BC, $16FBC, $1279E, $16F9E, $1D960, $1ECB8, $1F65E, $1B240, $1D930, $1EC9C, $1B220, $1D918
Data.l $1EC8E, $1B210, $1D90C, $1B208, $1B204, $19160, $1C8B8, $1E45E, $1B360, $19130, $1C89C, $16640
Data.l $12220, $1D99C, $1C88E, $16620, $12210, $1910C, $16610, $1B30C, $19106, $12204, $12360, $191B8
Data.l $1C8DE, $16760, $12330, $1919C, $16730, $1B39C, $1918E, $16718, $1230C, $12306, $123B8, $191DE
Data.l $167B8, $1239C, $1679C, $1238E, $1678E, $167DE, $1B140, $1D8B0, $1EC5C, $1B120, $1D898, $1EC4E
Data.l $1B110, $1D88C, $1B108, $1D886, $1B104, $1B102, $12140, $190B0, $1C85C, $16340, $12120, $19098
Data.l $1C84E, $16320, $1B198, $1D8CE, $16310, $12108, $19086, $16308, $1B186, $16304, $121B0, $190DC
Data.l $163B0, $12198, $190CE, $16398, $1B1CE, $1638C, $12186, $16386, $163DC, $163CE, $1B0A0, $1D858
Data.l $1EC2E, $1B090, $1D84C, $1B088, $1D846, $1B084, $1B082, $120A0, $19058, $1C82E, $161A0, $12090
Data.l $1904C, $16190, $1B0CC, $19046, $16188, $12084, $16184, $12082, $120D8, $161D8, $161CC, $161C6
Data.l $1D82C, $1D826, $1B042, $1902C, $12048, $160C8, $160C4, $160C2, $18AC0, $1C570, $1E2BC, $18A60
Data.l $1C538, $11440, $18A30, $1C51C, $11420, $18A18, $11410, $11408, $116C0, $18B70, $1C5BC, $11660
Data.l $18B38, $1C59E, $11630, $18B1C, $11618, $1160C, $11770, $18BBC, $11738, $18B9E, $1171C, $117BC
Data.l $1179E, $1CD60, $1E6B8, $1F35E, $19A40, $1CD30, $1E69C, $19A20, $1CD18, $1E68E, $19A10, $1CD0C
Data.l $19A08, $1CD06, $18960, $1C4B8, $1E25E, $19B60, $18930, $1C49C, $13640, $11220, $1CD9C, $1C48E
Data.l $13620, $19B18, $1890C, $13610, $11208, $13608, $11360, $189B8, $1C4DE, $13760, $11330, $1CDDE
Data.l $13730, $19B9C, $1898E, $13718, $1130C, $1370C, $113B8, $189DE, $137B8, $1139C, $1379C, $1138E
Data.l $113DE, $137DE, $1DD40, $1EEB0, $1F75C, $1DD20, $1EE98, $1F74E, $1DD10, $1EE8C, $1DD08, $1EE86
Data.l $1DD04, $19940, $1CCB0, $1E65C, $1BB40, $19920, $1EEDC, $1E64E, $1BB20, $1DD98, $1EECE, $1BB10
Data.l $19908, $1CC86, $1BB08, $1DD86, $19902, $11140, $188B0, $1C45C, $13340, $11120, $18898, $1C44E
Data.l $17740, $13320, $19998, $1CCCE, $17720, $1BB98, $1DDCE, $18886, $17710, $13308, $19986, $17708
Data.l $11102, $111B0, $188DC, $133B0, $11198, $188CE, $177B0, $13398, $199CE, $17798, $1BBCE, $11186
Data.l $13386, $111DC, $133DC, $111CE, $177DC, $133CE, $1DCA0, $1EE58, $1F72E, $1DC90, $1EE4C, $1DC88
Data.l $1EE46, $1DC84, $1DC82, $198A0, $1CC58, $1E62E, $1B9A0, $19890, $1EE6E, $1B990, $1DCCC, $1CC46
Data.l $1B988, $19884, $1B984, $19882, $1B982, $110A0, $18858, $1C42E, $131A0, $11090, $1884C, $173A0
Data.l $13190, $198CC, $18846, $17390, $1B9CC, $11084, $17388, $13184, $11082, $13182, $110D8, $1886E
Data.l $131D8, $110CC, $173D8, $131CC, $110C6, $173CC, $131C6, $110EE, $173EE, $1DC50, $1EE2C, $1DC48
Data.l $1EE26, $1DC44, $1DC42, $19850, $1CC2C, $1B8D0, $19848, $1CC26, $1B8C8, $1DC66, $1B8C4, $19842
Data.l $1B8C2, $11050, $1882C, $130D0, $11048, $18826, $171D0, $130C8, $19866, $171C8, $1B8E6, $11042
Data.l $171C4, $130C2, $171C2, $130EC, $171EC, $171E6, $1EE16, $1DC22, $1CC16, $19824, $19822, $11028
Data.l $13068, $170E8, $11022, $13062, $18560, $10A40, $18530, $10A20, $18518, $1C28E, $10A10, $1850C
Data.l $10A08, $18506, $10B60, $185B8, $1C2DE, $10B30, $1859C, $10B18, $1858E, $10B0C, $10B06, $10BB8
Data.l $185DE, $10B9C, $10B8E, $10BDE, $18D40, $1C6B0, $1E35C, $18D20, $1C698, $18D10, $1C68C, $18D08
Data.l $1C686, $18D04, $10940, $184B0, $1C25C, $11B40, $10920, $1C6DC, $1C24E, $11B20, $18D98, $1C6CE
Data.l $11B10, $10908, $18486, $11B08, $18D86, $10902, $109B0, $184DC, $11BB0, $10998, $184CE, $11B98
Data.l $18DCE, $11B8C, $10986, $109DC, $11BDC, $109CE, $11BCE, $1CEA0, $1E758, $1F3AE, $1CE90, $1E74C
Data.l $1CE88, $1E746, $1CE84, $1CE82, $18CA0, $1C658, $19DA0, $18C90, $1C64C, $19D90, $1CECC, $1C646
Data.l $19D88, $18C84, $19D84, $18C82, $19D82, $108A0, $18458, $119A0, $10890, $1C66E, $13BA0, $11990
Data.l $18CCC, $18446, $13B90, $19DCC, $10884, $13B88, $11984, $10882, $11982, $108D8, $1846E, $119D8
Data.l $108CC, $13BD8, $119CC, $108C6, $13BCC, $119C6, $108EE, $119EE, $13BEE, $1EF50, $1F7AC, $1EF48
Data.l $1F7A6, $1EF44, $1EF42, $1CE50, $1E72C, $1DED0, $1EF6C, $1E726, $1DEC8, $1EF66, $1DEC4, $1CE42
Data.l $1DEC2, $18C50, $1C62C, $19CD0, $18C48, $1C626, $1BDD0, $19CC8, $1CE66, $1BDC8, $1DEE6, $18C42
Data.l $1BDC4, $19CC2, $1BDC2, $10850, $1842C, $118D0, $10848, $18426, $139D0, $118C8, $18C66, $17BD0
Data.l $139C8, $19CE6, $10842, $17BC8, $1BDE6, $118C2, $17BC4, $1086C, $118EC, $10866, $139EC, $118E6
Data.l $17BEC, $139E6, $17BE6, $1EF28, $1F796, $1EF24, $1EF22, $1CE28, $1E716, $1DE68, $1EF36, $1DE64
Data.l $1CE22, $1DE62, $18C28, $1C616, $19C68, $18C24, $1BCE8, $19C64, $18C22, $1BCE4, $19C62, $1BCE2
Data.l $10828, $18416, $11868, $18C36, $138E8, $11864, $10822, $179E8, $138E4, $11862, $179E4, $138E2
Data.l $179E2, $11876, $179F6, $1EF12, $1DE34, $1DE32, $19C34, $1BC74, $1BC72, $11834, $13874, $178F4
Data.l $178F2, $10540, $10520, $18298, $10510, $10508, $10504, $105B0, $10598, $1058C, $10586, $105DC
Data.l $105CE, $186A0, $18690, $1C34C, $18688, $1C346, $18684, $18682, $104A0, $18258, $10DA0, $186D8
Data.l $1824C, $10D90, $186CC, $10D88, $186C6, $10D84, $10482, $10D82, $104D8, $1826E, $10DD8, $186EE
Data.l $10DCC, $104C6, $10DC6, $104EE, $10DEE, $1C750, $1C748, $1C744, $1C742, $18650, $18ED0, $1C76C
Data.l $1C326, $18EC8, $1C766, $18EC4, $18642, $18EC2, $10450, $10CD0, $10448, $18226, $11DD0, $10CC8
Data.l $10444, $11DC8, $10CC4, $10442, $11DC4, $10CC2, $1046C, $10CEC, $10466, $11DEC, $10CE6, $11DE6
Data.l $1E7A8, $1E7A4, $1E7A2, $1C728, $1CF68, $1E7B6, $1CF64, $1C722, $1CF62, $18628, $1C316, $18E68
Data.l $1C736, $19EE8, $18E64, $18622, $19EE4, $18E62, $19EE2, $10428, $18216, $10C68, $18636, $11CE8
Data.l $10C64, $10422, $13DE8, $11CE4, $10C62, $13DE4, $11CE2, $10436, $10C76, $11CF6, $13DF6, $1F7D4
Data.l $1F7D2, $1E794, $1EFB4, $1E792, $1EFB2, $1C714, $1CF34, $1C712, $1DF74, $1CF32, $1DF72, $18614
Data.l $18E34, $18612, $19E74, $18E32, $1BEF4
; cluster 3 (lignes 1, 4, 7...)
Data.l $1F560, $1FAB8, $1EA40, $1F530, $1FA9C, $1EA20, $1F518, $1FA8E, $1EA10, $1F50C, $1EA08, $1F506
Data.l $1EA04, $1EB60, $1F5B8, $1FADE, $1D640, $1EB30, $1F59C, $1D620, $1EB18, $1F58E, $1D610, $1EB0C
Data.l $1D608, $1EB06, $1D604, $1D760, $1EBB8, $1F5DE, $1AE40, $1D730, $1EB9C, $1AE20, $1D718, $1EB8E
Data.l $1AE10, $1D70C, $1AE08, $1D706, $1AE04, $1AF60, $1D7B8, $1EBDE, $15E40, $1AF30, $1D79C, $15E20
Data.l $1AF18, $1D78E, $15E10, $1AF0C, $15E08, $1AF06, $15F60, $1AFB8, $1D7DE, $15F30, $1AF9C, $15F18
Data.l $1AF8E, $15F0C, $15FB8, $1AFDE, $15F9C, $15F8E, $1E940, $1F4B0, $1FA5C, $1E920, $1F498, $1FA4E
Data.l $1E910, $1F48C, $1E908, $1F486, $1E904, $1E902, $1D340, $1E9B0, $1F4DC, $1D320, $1E998, $1F4CE
Data.l $1D310, $1E98C, $1D308, $1E986, $1D304, $1D302, $1A740, $1D3B0, $1E9DC, $1A720, $1D398, $1E9CE
Data.l $1A710, $1D38C, $1A708, $1D386, $1A704, $1A702, $14F40, $1A7B0, $1D3DC, $14F20, $1A798, $1D3CE
Data.l $14F10, $1A78C, $14F08, $1A786, $14F04, $14FB0, $1A7DC, $14F98, $1A7CE, $14F8C, $14F86, $14FDC
Data.l $14FCE, $1E8A0, $1F458, $1FA2E, $1E890, $1F44C, $1E888, $1F446, $1E884, $1E882, $1D1A0, $1E8D8
Data.l $1F46E, $1D190, $1E8CC, $1D188, $1E8C6, $1D184, $1D182, $1A3A0, $1D1D8, $1E8EE, $1A390, $1D1CC
Data.l $1A388, $1D1C6, $1A384, $1A382, $147A0, $1A3D8, $1D1EE, $14790, $1A3CC, $14788, $1A3C6, $14784
Data.l $14782, $147D8, $1A3EE, $147CC, $147C6, $147EE, $1E850, $1F42C, $1E848, $1F426, $1E844, $1E842
Data.l $1D0D0, $1E86C, $1D0C8, $1E866, $1D0C4, $1D0C2, $1A1D0, $1D0EC, $1A1C8, $1D0E6, $1A1C4, $1A1C2
Data.l $143D0, $1A1EC, $143C8, $1A1E6, $143C4, $143C2, $143EC, $143E6, $1E828, $1F416, $1E824, $1E822
Data.l $1D068, $1E836, $1D064, $1D062, $1A0E8, $1D076, $1A0E4, $1A0E2, $141E8, $1A0F6, $141E4, $141E2
Data.l $1E814, $1E812, $1D034, $1D032, $1A074, $1A072, $1E540, $1F2B0, $1F95C, $1E520, $1F298, $1F94E
Data.l $1E510, $1F28C, $1E508, $1F286, $1E504, $1E502, $1CB40, $1E5B0, $1F2DC, $1CB20, $1E598, $1F2CE
Data.l $1CB10, $1E58C, $1CB08, $1E586, $1CB04, $1CB02, $19740, $1CBB0, $1E5DC, $19720, $1CB98, $1E5CE
Data.l $19710, $1CB8C, $19708, $1CB86, $19704, $19702, $12F40, $197B0, $1CBDC, $12F20, $19798, $1CBCE
Data.l $12F10, $1978C, $12F08, $19786, $12F04, $12FB0, $197DC, $12F98, $197CE, $12F8C, $12F86, $12FDC
Data.l $12FCE, $1F6A0, $1FB58, $16BF0, $1F690, $1FB4C, $169F8, $1F688, $1FB46, $168FC, $1F684, $1F682
Data.l $1E4A0, $1F258, $1F92E, $1EDA0, $1E490, $1FB6E, $1ED90, $1F6CC, $1F246, $1ED88, $1E484, $1ED84
Data.l $1E482, $1ED82, $1C9A0, $1E4D8, $1F26E, $1DBA0, $1C990, $1E4CC, $1DB90, $1EDCC, $1E4C6, $1DB88
Data.l $1C984, $1DB84, $1C982, $1DB82, $193A0, $1C9D8, $1E4EE, $1B7A0, $19390, $1C9CC, $1B790, $1DBCC
Data.l $1C9C6, $1B788, $19384, $1B784, $19382, $1B782, $127A0, $193D8, $1C9EE, $16FA0, $12790, $193CC
Data.l $16F90, $1B7CC, $193C6, $16F88, $12784, $16F84, $12782, $127D8, $193EE, $16FD8, $127CC, $16FCC
Data.l $127C6, $16FC6, $127EE, $1F650, $1FB2C, $165F8, $1F648, $1FB26, $164FC, $1F644, $1647E, $1F642
Data.l $1E450, $1F22C, $1ECD0, $1E448, $1F226, $1ECC8, $1F666, $1ECC4, $1E442, $1ECC2, $1C8D0, $1E46C
Data.l $1D9D0, $1C8C8, $1E466, $1D9C8, $1ECE6, $1D9C4, $1C8C2, $1D9C2, $191D0, $1C8EC, $1B3D0, $191C8
Data.l $1C8E6, $1B3C8, $1D9E6, $1B3C4, $191C2, $1B3C2, $123D0, $191EC, $167D0, $123C8, $191E6, $167C8
Data.l $1B3E6, $167C4, $123C2, $167C2, $123EC, $167EC, $123E6, $167E6, $1F628, $1FB16, $162FC, $1F624
Data.l $1627E, $1F622, $1E428, $1F216, $1EC68, $1F636, $1EC64, $1E422, $1EC62, $1C868, $1E436, $1D8E8
Data.l $1C864, $1D8E4, $1C862, $1D8E2, $190E8, $1C876, $1B1E8, $1D8F6, $1B1E4, $190E2, $1B1E2, $121E8
Data.l $190F6, $163E8, $121E4, $163E4, $121E2, $163E2, $121F6, $163F6, $1F614, $1617E, $1F612, $1E414
Data.l $1EC34, $1E412, $1EC32, $1C834, $1D874, $1C832, $1D872, $19074, $1B0F4, $19072, $1B0F2, $120F4
Data.l $161F4, $120F2, $161F2, $1F60A, $1E40A, $1EC1A, $1C81A, $1D83A, $1903A, $1B07A, $1E2A0, $1F158
Data.l $1F8AE, $1E290, $1F14C, $1E288, $1F146, $1E284, $1E282, $1C5A0, $1E2D8, $1F16E, $1C590, $1E2CC
Data.l $1C588, $1E2C6, $1C584, $1C582, $18BA0, $1C5D8, $1E2EE, $18B90, $1C5CC, $18B88, $1C5C6, $18B84
Data.l $18B82, $117A0, $18BD8, $1C5EE, $11790, $18BCC, $11788, $18BC6, $11784, $11782, $117D8, $18BEE
Data.l $117CC, $117C6, $117EE, $1F350, $1F9AC, $135F8, $1F348, $1F9A6, $134FC, $1F344, $1347E, $1F342
Data.l $1E250, $1F12C, $1E6D0, $1E248, $1F126, $1E6C8, $1F366, $1E6C4, $1E242, $1E6C2, $1C4D0, $1E26C
Data.l $1CDD0, $1C4C8, $1E266, $1CDC8, $1E6E6, $1CDC4, $1C4C2, $1CDC2, $189D0, $1C4EC, $19BD0, $189C8
Data.l $1C4E6, $19BC8, $1CDE6, $19BC4, $189C2, $19BC2, $113D0, $189EC, $137D0, $113C8, $189E6, $137C8
Data.l $19BE6, $137C4, $113C2, $137C2, $113EC, $137EC, $113E6, $137E6, $1FBA8, $175F0, $1BAFC, $1FBA4
Data.l $174F8, $1BA7E, $1FBA2, $1747C, $1743E, $1F328, $1F996, $132FC, $1F768, $1FBB6, $176FC, $1327E
Data.l $1F764, $1F322, $1767E, $1F762, $1E228, $1F116, $1E668, $1E224, $1EEE8, $1F776, $1E222, $1EEE4
Data.l $1E662, $1EEE2, $1C468, $1E236, $1CCE8, $1C464, $1DDE8, $1CCE4, $1C462, $1DDE4, $1CCE2, $1DDE2
Data.l $188E8, $1C476, $199E8, $188E4, $1BBE8, $199E4, $188E2, $1BBE4, $199E2, $1BBE2, $111E8, $188F6
Data.l $133E8, $111E4, $177E8, $133E4, $111E2, $177E4, $133E2, $177E2, $111F6, $133F6, $1FB94, $172F8
Data.l $1B97E, $1FB92, $1727C, $1723E, $1F314, $1317E, $1F734, $1F312, $1737E, $1F732, $1E214, $1E634
Data.l $1E212, $1EE74, $1E632, $1EE72, $1C434, $1CC74, $1C432, $1DCF4, $1CC72, $1DCF2, $18874, $198F4
Data.l $18872, $1B9F4, $198F2, $1B9F2, $110F4, $131F4, $110F2, $173F4, $131F2, $173F2, $1FB8A, $1717C
Data.l $1713E, $1F30A, $1F71A, $1E20A, $1E61A, $1EE3A, $1C41A, $1CC3A, $1DC7A, $1883A, $1987A, $1B8FA
Data.l $1107A, $130FA, $171FA, $170BE, $1E150, $1F0AC, $1E148, $1F0A6, $1E144, $1E142, $1C2D0, $1E16C
Data.l $1C2C8, $1E166, $1C2C4, $1C2C2, $185D0, $1C2EC, $185C8, $1C2E6, $185C4, $185C2, $10BD0, $185EC
Data.l $10BC8, $185E6, $10BC4, $10BC2, $10BEC, $10BE6, $1F1A8, $1F8D6, $11AFC, $1F1A4, $11A7E, $1F1A2
Data.l $1E128, $1F096, $1E368, $1E124, $1E364, $1E122, $1E362, $1C268, $1E136, $1C6E8, $1C264, $1C6E4
Data.l $1C262, $1C6E2, $184E8, $1C276, $18DE8, $184E4, $18DE4, $184E2, $18DE2, $109E8, $184F6, $11BE8
Data.l $109E4, $11BE4, $109E2, $11BE2, $109F6, $11BF6, $1F9D4, $13AF8, $19D7E, $1F9D2, $13A7C, $13A3E
Data.l $1F194, $1197E, $1F3B4, $1F192, $13B7E, $1F3B2, $1E114, $1E334, $1E112, $1E774, $1E332, $1E772
Data.l $1C234, $1C674, $1C232, $1CEF4, $1C672, $1CEF2, $18474, $18CF4, $18472, $19DF4, $18CF2, $19DF2
Data.l $108F4, $119F4, $108F2, $13BF4, $119F2, $13BF2, $17AF0, $1BD7C, $17A78, $1BD3E, $17A3C, $17A1E
Data.l $1F9CA, $1397C, $1FBDA, $17B7C, $1393E, $17B3E, $1F18A, $1F39A, $1F7BA, $1E10A, $1E31A, $1E73A
Data.l $1EF7A, $1C21A, $1C63A, $1CE7A, $1DEFA, $1843A, $18C7A, $19CFA, $1BDFA, $1087A, $118FA, $139FA
Data.l $17978, $1BCBE, $1793C, $1791E, $138BE, $179BE, $178BC, $1789E, $1785E, $1E0A8, $1E0A4, $1E0A2
Data.l $1C168, $1E0B6, $1C164, $1C162, $182E8, $1C176, $182E4, $182E2, $105E8, $182F6, $105E4, $105E2
Data.l $105F6, $1F0D4, $10D7E, $1F0D2, $1E094, $1E1B4, $1E092, $1E1B2, $1C134, $1C374, $1C132, $1C372
Data.l $18274, $186F4, $18272, $186F2, $104F4, $10DF4, $104F2, $10DF2, $1F8EA, $11D7C, $11D3E, $1F0CA
Data.l $1F1DA, $1E08A, $1E19A, $1E3BA, $1C11A, $1C33A, $1C77A, $1823A, $1867A, $18EFA, $1047A, $10CFA
Data.l $11DFA, $13D78, $19EBE, $13D3C, $13D1E, $11CBE, $13DBE, $17D70, $1BEBC, $17D38, $1BE9E, $17D1C
Data.l $17D0E, $13CBC, $17DBC, $13C9E, $17D9E, $17CB8, $1BE5E, $17C9C, $17C8E, $13C5E, $17CDE, $17C5C
Data.l $17C4E, $17C2E, $1C0B4, $1C0B2, $18174, $18172, $102F4, $102F2, $1E0DA, $1C09A, $1C1BA, $1813A
Data.l $1837A, $1027A, $106FA, $10EBE, $11EBC, $11E9E, $13EB8, $19F5E, $13E9C, $13E8E, $11E5E, $13EDE
Data.l $17EB0, $1BF5C, $17E98, $1BF4E, $17E8C, $17E86, $13E5C, $17EDC, $13E4E, $17ECE, $17E58, $1BF2E
Data.l $17E4C, $17E46, $13E2E, $17E6E, $17E2C, $17E26, $10F5E, $11F5C, $11F4E, $13F58, $19FAE, $13F4C
Data.l $13F46, $11F2E, $13F6E, $13F2C, $13F26
; cluster 6 (lignes 2, 5, 8...)
Data.l $1ABE0, $1D5F8, $153C0, $1A9F0, $1D4FC, $151E0, $1A8F8, $1D47E, $150F0, $1A87C, $15078, $1FAD0
Data.l $15BE0, $1ADF8, $1FAC8, $159F0, $1ACFC, $1FAC4, $158F8, $1AC7E, $1FAC2, $1587C, $1F5D0, $1FAEC
Data.l $15DF8, $1F5C8, $1FAE6, $15CFC, $1F5C4, $15C7E, $1F5C2, $1EBD0, $1F5EC, $1EBC8, $1F5E6, $1EBC4
Data.l $1EBC2, $1D7D0, $1EBEC, $1D7C8, $1EBE6, $1D7C4, $1D7C2, $1AFD0, $1D7EC, $1AFC8, $1D7E6, $1AFC4
Data.l $14BC0, $1A5F0, $1D2FC, $149E0, $1A4F8, $1D27E, $148F0, $1A47C, $14878, $1A43E, $1483C, $1FA68
Data.l $14DF0, $1A6FC, $1FA64, $14CF8, $1A67E, $1FA62, $14C7C, $14C3E, $1F4E8, $1FA76, $14EFC, $1F4E4
Data.l $14E7E, $1F4E2, $1E9E8, $1F4F6, $1E9E4, $1E9E2, $1D3E8, $1E9F6, $1D3E4, $1D3E2, $1A7E8, $1D3F6
Data.l $1A7E4, $1A7E2, $145E0, $1A2F8, $1D17E, $144F0, $1A27C, $14478, $1A23E, $1443C, $1441E, $1FA34
Data.l $146F8, $1A37E, $1FA32, $1467C, $1463E, $1F474, $1477E, $1F472, $1E8F4, $1E8F2, $1D1F4, $1D1F2
Data.l $1A3F4, $1A3F2, $142F0, $1A17C, $14278, $1A13E, $1423C, $1421E, $1FA1A, $1437C, $1433E, $1F43A
Data.l $1E87A, $1D0FA, $14178, $1A0BE, $1413C, $1411E, $141BE, $140BC, $1409E, $12BC0, $195F0, $1CAFC
Data.l $129E0, $194F8, $1CA7E, $128F0, $1947C, $12878, $1943E, $1283C, $1F968, $12DF0, $196FC, $1F964
Data.l $12CF8, $1967E, $1F962, $12C7C, $12C3E, $1F2E8, $1F976, $12EFC, $1F2E4, $12E7E, $1F2E2, $1E5E8
Data.l $1F2F6, $1E5E4, $1E5E2, $1CBE8, $1E5F6, $1CBE4, $1CBE2, $197E8, $1CBF6, $197E4, $197E2, $1B5E0
Data.l $1DAF8, $1ED7E, $169C0, $1B4F0, $1DA7C, $168E0, $1B478, $1DA3E, $16870, $1B43C, $16838, $1B41E
Data.l $1681C, $125E0, $192F8, $1C97E, $16DE0, $124F0, $1927C, $16CF0, $1B67C, $1923E, $16C78, $1243C
Data.l $16C3C, $1241E, $16C1E, $1F934, $126F8, $1937E, $1FB74, $1F932, $16EF8, $1267C, $1FB72, $16E7C
Data.l $1263E, $16E3E, $1F274, $1277E, $1F6F4, $1F272, $16F7E, $1F6F2, $1E4F4, $1EDF4, $1E4F2, $1EDF2
Data.l $1C9F4, $1DBF4, $1C9F2, $1DBF2, $193F4, $193F2, $165C0, $1B2F0, $1D97C, $164E0, $1B278, $1D93E
Data.l $16470, $1B23C, $16438, $1B21E, $1641C, $1640E, $122F0, $1917C, $166F0, $12278, $1913E, $16678
Data.l $1B33E, $1663C, $1221E, $1661E, $1F91A, $1237C, $1FB3A, $1677C, $1233E, $1673E, $1F23A, $1F67A
Data.l $1E47A, $1ECFA, $1C8FA, $1D9FA, $191FA, $162E0, $1B178, $1D8BE, $16270, $1B13C, $16238, $1B11E
Data.l $1621C, $1620E, $12178, $190BE, $16378, $1213C, $1633C, $1211E, $1631E, $121BE, $163BE, $16170
Data.l $1B0BC, $16138, $1B09E, $1611C, $1610E, $120BC, $161BC, $1209E, $1619E, $160B8, $1B05E, $1609C
Data.l $1608E, $1205E, $160DE, $1605C, $1604E, $115E0, $18AF8, $1C57E, $114F0, $18A7C, $11478, $18A3E
Data.l $1143C, $1141E, $1F8B4, $116F8, $18B7E, $1F8B2, $1167C, $1163E, $1F174, $1177E, $1F172, $1E2F4
Data.l $1E2F2, $1C5F4, $1C5F2, $18BF4, $18BF2, $135C0, $19AF0, $1CD7C, $134E0, $19A78, $1CD3E, $13470
Data.l $19A3C, $13438, $19A1E, $1341C, $1340E, $112F0, $1897C, $136F0, $11278, $1893E, $13678, $19B3E
Data.l $1363C, $1121E, $1361E, $1F89A, $1137C, $1F9BA, $1377C, $1133E, $1373E, $1F13A, $1F37A, $1E27A
Data.l $1E6FA, $1C4FA, $1CDFA, $189FA, $1BAE0, $1DD78, $1EEBE, $174C0, $1BA70, $1DD3C, $17460, $1BA38
Data.l $1DD1E, $17430, $1BA1C, $17418, $1BA0E, $1740C, $132E0, $19978, $1CCBE, $176E0, $13270, $1993C
Data.l $17670, $1BB3C, $1991E, $17638, $1321C, $1761C, $1320E, $1760E, $11178, $188BE, $13378, $1113C
Data.l $17778, $1333C, $1111E, $1773C, $1331E, $1771E, $111BE, $133BE, $177BE, $172C0, $1B970, $1DCBC
Data.l $17260, $1B938, $1DC9E, $17230, $1B91C, $17218, $1B90E, $1720C, $17206, $13170, $198BC, $17370
Data.l $13138, $1989E, $17338, $1B99E, $1731C, $1310E, $1730E, $110BC, $131BC, $1109E, $173BC, $1319E
Data.l $1739E, $17160, $1B8B8, $1DC5E, $17130, $1B89C, $17118, $1B88E, $1710C, $17106, $130B8, $1985E
Data.l $171B8, $1309C, $1719C, $1308E, $1718E, $1105E, $130DE, $171DE, $170B0, $1B85C, $17098, $1B84E
Data.l $1708C, $17086, $1305C, $170DC, $1304E, $170CE, $17058, $1B82E, $1704C, $17046, $1302E, $1706E
Data.l $1702C, $17026, $10AF0, $1857C, $10A78, $1853E, $10A3C, $10A1E, $10B7C, $10B3E, $1F0BA, $1E17A
Data.l $1C2FA, $185FA, $11AE0, $18D78, $1C6BE, $11A70, $18D3C, $11A38, $18D1E, $11A1C, $11A0E, $10978
Data.l $184BE, $11B78, $1093C, $11B3C, $1091E, $11B1E, $109BE, $11BBE, $13AC0, $19D70, $1CEBC, $13A60
Data.l $19D38, $1CE9E, $13A30, $19D1C, $13A18, $19D0E, $13A0C, $13A06, $11970, $18CBC, $13B70, $11938
Data.l $18C9E, $13B38, $1191C, $13B1C, $1190E, $13B0E, $108BC, $119BC, $1089E, $13BBC, $1199E, $13B9E
Data.l $1BD60, $1DEB8, $1EF5E, $17A40, $1BD30, $1DE9C, $17A20, $1BD18, $1DE8E, $17A10, $1BD0C, $17A08
Data.l $1BD06, $17A04, $13960, $19CB8, $1CE5E, $17B60, $13930, $19C9C, $17B30, $1BD9C, $19C8E, $17B18
Data.l $1390C, $17B0C, $13906, $17B06, $118B8, $18C5E, $139B8, $1189C, $17BB8, $1399C, $1188E, $17B9C
Data.l $1398E, $17B8E, $1085E, $118DE, $139DE, $17BDE, $17940, $1BCB0, $1DE5C, $17920, $1BC98, $1DE4E
Data.l $17910, $1BC8C, $17908, $1BC86, $17904, $17902, $138B0, $19C5C, $179B0, $13898, $19C4E, $17998
Data.l $1BCCE, $1798C, $13886, $17986, $1185C, $138DC, $1184E, $179DC, $138CE, $179CE, $178A0, $1BC58
Data.l $1DE2E, $17890, $1BC4C, $17888, $1BC46, $17884, $17882, $13858, $19C2E, $178D8, $1384C, $178CC
Data.l $13846, $178C6, $1182E, $1386E, $178EE, $17850, $1BC2C, $17848, $1BC26, $17844, $17842, $1382C
Data.l $1786C, $13826, $17866, $17828, $1BC16, $17824, $17822, $13816, $17836, $10578, $182BE, $1053C
Data.l $1051E, $105BE, $10D70, $186BC, $10D38, $1869E, $10D1C, $10D0E, $104BC, $10DBC, $1049E, $10D9E
Data.l $11D60, $18EB8, $1C75E, $11D30, $18E9C, $11D18, $18E8E, $11D0C, $11D06, $10CB8, $1865E, $11DB8
Data.l $10C9C, $11D9C, $10C8E, $11D8E, $1045E, $10CDE, $11DDE, $13D40, $19EB0, $1CF5C, $13D20, $19E98
Data.l $1CF4E, $13D10, $19E8C, $13D08, $19E86, $13D04, $13D02, $11CB0, $18E5C, $13DB0, $11C98, $18E4E
Data.l $13D98, $19ECE, $13D8C, $11C86, $13D86, $10C5C, $11CDC, $10C4E, $13DDC, $11CCE, $13DCE, $1BEA0
Data.l $1DF58, $1EFAE, $1BE90, $1DF4C, $1BE88, $1DF46, $1BE84, $1BE82, $13CA0, $19E58, $1CF2E, $17DA0
Data.l $13C90, $19E4C, $17D90, $1BECC, $19E46, $17D88, $13C84, $17D84, $13C82, $17D82, $11C58, $18E2E
Data.l $13CD8, $11C4C, $17DD8, $13CCC, $11C46, $17DCC, $13CC6, $17DC6, $10C2E, $11C6E, $13CEE, $17DEE
Data.l $1BE50, $1DF2C, $1BE48, $1DF26, $1BE44, $1BE42, $13C50, $19E2C, $17CD0, $13C48, $19E26, $17CC8
Data.l $1BE66, $17CC4, $13C42, $17CC2, $11C2C, $13C6C, $11C26, $17CEC, $13C66, $17CE6, $1BE28, $1DF16
Data.l $1BE24, $1BE22, $13C28, $19E16, $17C68, $13C24, $17C64, $13C22, $17C62, $11C16, $13C36, $17C76
Data.l $1BE14, $1BE12, $13C14, $17C34, $13C12, $17C32, $102BC, $1029E, $106B8, $1835E, $1069C, $1068E
Data.l $1025E, $106DE, $10EB0, $1875C, $10E98, $1874E, $10E8C, $10E86, $1065C, $10EDC, $1064E, $10ECE
Data.l $11EA0, $18F58, $1C7AE, $11E90, $18F4C, $11E88, $18F46, $11E84, $11E82, $10E58, $1872E, $11ED8
Data.l $18F6E, $11ECC, $10E46, $11EC6, $1062E, $10E6E, $11EEE, $19F50, $1CFAC, $19F48, $1CFA6, $19F44
Data.l $19F42, $11E50, $18F2C, $13ED0, $19F6C, $18F26, $13EC8, $11E44, $13EC4, $11E42, $13EC2, $10E2C
Data.l $11E6C, $10E26, $13EEC, $11E66, $13EE6, $1DFA8, $1EFD6, $1DFA4, $1DFA2, $19F28, $1CF96, $1BF68
Data.l $19F24, $1BF64, $19F22, $1BF62, $11E28, $18F16, $13E68, $11E24, $17EE8, $13E64, $11E22, $17EE4
Data.l $13E62, $17EE2, $10E16, $11E36, $13E76, $17EF6, $1DF94, $1DF92, $19F14, $1BF34, $19F12, $1BF32
Data.l $11E14, $13E34, $11E12, $17E74, $13E32, $17E72, $1DF8A, $19F0A, $1BF1A, $11E0A, $13E1A, $17E3A
Data.l $1035C, $1034E, $10758, $183AE, $1074C, $10746, $1032E, $1076E, $10F50, $187AC, $10F48, $187A6
Data.l $10F44, $10F42, $1072C, $10F6C, $10726, $10F66, $18FA8, $1C7D6, $18FA4, $18FA2, $10F28, $18796
Data.l $11F68, $18FB6, $11F64, $10F22, $11F62, $10716, $10F36, $11F76, $1CFD4, $1CFD2, $18F94, $19FB4
Data.l $18F92, $19FB2, $10F14, $11F34, $10F12, $13F74, $11F32, $13F72, $1CFCA, $18F8A, $19F9A, $10F0A
Data.l $11F1A, $13F3A, $103AC, $103A6, $107A8, $183D6, $107A4, $107A2, $10396, $107B6, $187D4, $187D2
Data.l $10794, $10FB4, $10792, $10FB2, $1C7EA
EndDataSection
; ****************************************************************************
;- Outils
; Index d'un octet dans un sous-mode texte (0 = majuscules, 1 = minuscules,
; 2 = mixte, 3 = ponctuation), -1 si absent
Procedure.i pdf_textIdx(sm.i, b.i)
Protected v.i
If b < 0 Or b > 127
ProcedureReturn -1
EndIf
v = PeekA(?PDF_TextTable + sm * 128 + b)
If v = 255
ProcedureReturn -1
EndIf
ProcedureReturn v
EndProcedure
Procedure.i pdf_inText(b.i)
Protected sm.i
For sm = 0 To 3
If pdf_textIdx(sm, b) >= 0
ProcedureReturn #True
EndIf
Next sm
ProcedureReturn #False
EndProcedure
; Ajoute un codeword (le compteur avance toujours : un dépassement est détecté ensuite)
Procedure pdf_push(Array cw.i(1), *n.Integer, v.i)
If *n\i <= ArraySize(cw())
cw(*n\i) = v
EndIf
*n\i + 1
EndProcedure
; ****************************************************************************
;- Compactions
; Texte : 2 valeurs (0..29) par codeword, avec changements de sous-mode
Procedure pdf_text(Array b.a(1), start.i, length.i, Array cw.i(1), *n.Integer)
Protected sm.i = 0, ns.i, i.i, v.i, k.i, cnt.i
Protected Dim inter.i(length * 3 + 2)
For i = start To start + length - 1
v = b(i)
If pdf_textIdx(sm, v) < 0
; sous-mode préféré : minuscules, majuscules, mixte, ponctuation
If pdf_textIdx(1, v) >= 0
ns = 1
ElseIf pdf_textIdx(0, v) >= 0
ns = 0
ElseIf pdf_textIdx(2, v) >= 0
ns = 2
Else
ns = 3
EndIf
Select sm * 4 + ns
Case 1 : inter(cnt) = 27 : cnt + 1 ; majuscules -> minuscules
Case 2 : inter(cnt) = 28 : cnt + 1 ; majuscules -> mixte
Case 3 : inter(cnt) = 28 : cnt + 1 : inter(cnt) = 25 : cnt + 1 ; majuscules -> ponctuation
Case 4 : inter(cnt) = 28 : cnt + 1 : inter(cnt) = 28 : cnt + 1 ; minuscules -> majuscules
Case 6 : inter(cnt) = 28 : cnt + 1 ; minuscules -> mixte
Case 7 : inter(cnt) = 28 : cnt + 1 : inter(cnt) = 25 : cnt + 1 ; minuscules -> ponctuation
Case 8 : inter(cnt) = 28 : cnt + 1 ; mixte -> majuscules
Case 9 : inter(cnt) = 27 : cnt + 1 ; mixte -> minuscules
Case 11 : inter(cnt) = 25 : cnt + 1 ; mixte -> ponctuation
Case 12 : inter(cnt) = 29 : cnt + 1 ; ponctuation -> majuscules
Case 13 : inter(cnt) = 29 : cnt + 1 : inter(cnt) = 27 : cnt + 1 ; ponctuation -> minuscules
Case 14 : inter(cnt) = 29 : cnt + 1 : inter(cnt) = 28 : cnt + 1 ; ponctuation -> mixte
EndSelect
sm = ns
EndIf
inter(cnt) = pdf_textIdx(sm, v) : cnt + 1
Next i
If cnt % 2
inter(cnt) = 29 : cnt + 1 ; bourrage neutre
EndIf
For k = 0 To cnt - 1 Step 2
pdf_push(cw(), *n, 30 * inter(k) + inter(k + 1))
Next k
EndProcedure
; Octets : 6 octets -> 5 codewords (base 256 -> base 900), le reste tel quel
Procedure pdf_bytes(Array b.a(1), start.i, length.i, Array cw.i(1), *n.Integer)
Protected i.i = start, last.i = start + length, j.i
Protected v.q
Protected Dim g.i(4)
While i + 6 <= last
v = 0
For j = 0 To 5
v = v * 256 + b(i + j)
Next j
For j = 4 To 0 Step -1
g(j) = v % 900
v = v / 900
Next j
For j = 0 To 4
pdf_push(cw(), *n, g(j))
Next j
i + 6
Wend
While i < last
pdf_push(cw(), *n, b(i))
i + 1
Wend
EndProcedure
; Numérique : blocs de 44 chiffres, "1" + chiffres converti en base 900
Procedure pdf_numeric(Array b.a(1), start.i, length.i, Array cw.i(1), *n.Integer)
Protected pos.i = start, last.i = start + length
Protected cnt.i, i.i, nd.i, nq.i, nres.i, rem.i, cur.i, allzero.i
Protected Dim dig.i(45)
Protected Dim q.i(45)
Protected Dim res.i(20)
While pos < last
cnt = last - pos
If cnt > 44
cnt = 44
EndIf
dig(0) = 1
For i = 0 To cnt - 1
dig(i + 1) = b(pos + i) - '0'
Next i
nd = cnt + 1
nres = 0
Repeat
; division longue du nombre décimal par 900
rem = 0
nq = 0
For i = 0 To nd - 1
cur = rem * 10 + dig(i)
q(nq) = cur / 900 : nq + 1
rem = cur % 900
Next i
res(nres) = rem : nres + 1
; quotient sans zéros de tête -> nouveau dividende
i = 0
While i < nq - 1 And q(i) = 0
i + 1
Wend
nd = 0
allzero = #True
While i < nq
dig(nd) = q(i)
If q(i) <> 0
allzero = #False
EndIf
nd + 1
i + 1
Wend
Until allzero
For i = nres - 1 To 0 Step -1
pdf_push(cw(), *n, res(i))
Next i
pos + cnt
Wend
EndProcedure
; ****************************************************************************
;- Dessin d'un motif (à appeler entre StartDrawing / StopDrawing)
Procedure.i pdf_drawPattern(p.i, nbits.i, x.i, y.i, h.i, mw.i, color.i)
Protected bit.i
For bit = nbits - 1 To 0 Step -1
If (p >> bit) & 1
Box(x * mw, y, mw, h, color)
EndIf
x + 1
Next bit
ProcedureReturn x
EndProcedure
; ****************************************************************************
;- Procédure principale
; ModuleW : largeur d'un module en pixels (épaisseur de la barre la plus fine)
; MaxWidth : largeur maximale de l'image en pixels, 0 = libre
; Columns : nombre de colonnes de données (1..30), 0 = automatique
; Security : niveau de correction (0..8), -1 = automatique (recommandation de la norme)
; RowRatio : hauteur d'une ligne en modules (3 minimum recommandé)
; QuietZone : marge blanche en modules (norme : 2)
; Retour : image #PB_Any (à libérer par l'appelant) ou 0 en cas d'échec
Procedure.i Get_BarcodePDF417(Text.s, color = #Black, backcolor = #White, ModuleW.i = 2, MaxWidth.i = 0, Columns.i = 0, Security.i = -1, RowRatio.i = 3, QuietZone.i = 2)
Protected *mem
Protected.i i, j, k, n, useUTF8, byteLen, nRuns, nM, cls
Protected.i ecCount, need, c, rows, w, best, maxw, pad, total, deg, a, t, prev, cl, c30, L, R, x, y, h
Protected.i imgW, imgH, img, symW
Protected *ch.Character
If Text = #Null$
ProcedureReturn 0
EndIf
If ModuleW < 1 : ModuleW = 1 : EndIf
If RowRatio < 1 : RowRatio = 1 : EndIf
If QuietZone < 0 : QuietZone = 0 : EndIf
If Security > 8 : Security = 8 : EndIf
If Columns > 30 : Columns = 30 : EndIf
; --- 1. Texte -> octets (ASCII, ou UTF-8 si un caractère > 127)
*ch = @Text
While *ch\c
If *ch\c > 127
useUTF8 = #True
Break
EndIf
*ch + SizeOf(Character)
Wend
If useUTF8
byteLen = StringByteLength(Text, #PB_UTF8)
Dim bytes.a(byteLen)
*mem = AllocateMemory(byteLen + 1)
If *mem = 0
ProcedureReturn 0
EndIf
PokeS(*mem, Text, -1, #PB_UTF8 | #PB_String_NoZero)
For i = 0 To byteLen - 1
bytes(i) = PeekA(*mem + i)
Next i
FreeMemory(*mem)
Else
byteLen = Len(Text)
Dim bytes.a(byteLen)
*ch = @Text
For i = 0 To byteLen - 1
bytes(i) = *ch\c
*ch + SizeOf(Character)
Next i
EndIf
; --- 2. Découpage en segments texte / octets / numérique
Dim rC.i(byteLen)
Dim rS.i(byteLen)
Dim rL.i(byteLen)
nRuns = 0
For i = 0 To byteLen - 1
If bytes(i) >= '0' And bytes(i) <= '9'
cls = #PDF_CLASS_NUMERIC
ElseIf pdf_inText(bytes(i))
cls = #PDF_CLASS_TEXT
Else
cls = #PDF_CLASS_BYTE
EndIf
If nRuns > 0 And rC(nRuns - 1) = cls
rL(nRuns - 1) = rL(nRuns - 1) + 1
Else
rC(nRuns) = cls : rS(nRuns) = i : rL(nRuns) = 1
nRuns + 1
EndIf
Next i
; moins de 13 chiffres collés à du texte : on les garde en texte
For k = 0 To nRuns - 1
If rC(k) = #PDF_CLASS_NUMERIC And rL(k) < 13
If (k > 0 And rC(k - 1) = #PDF_CLASS_TEXT) Or (k + 1 < nRuns And rC(k + 1) = #PDF_CLASS_TEXT)
rC(k) = #PDF_CLASS_TEXT
EndIf
EndIf
Next k
; fusion des segments voisins de même type
nM = 0
For k = 0 To nRuns - 1
If nM > 0 And rC(nM - 1) = rC(k)
rL(nM - 1) = rL(nM - 1) + rL(k)
Else
rC(nM) = rC(k) : rS(nM) = rS(k) : rL(nM) = rL(k)
nM + 1
EndIf
Next k
; --- 3. Compaction -> codewords de données
Dim cw.i(byteLen * 2 + 40)
n = 0
If useUTF8
pdf_push(cw(), @n, 927) ; ECI
pdf_push(cw(), @n, 26) ; 26 = UTF-8
EndIf
For k = 0 To nM - 1
Select rC(k)
Case #PDF_CLASS_TEXT
If k > 0
pdf_push(cw(), @n, 900) ; retour en mode texte
EndIf
pdf_text(bytes(), rS(k), rL(k), cw(), @n)
Case #PDF_CLASS_BYTE
If rL(k) % 6 = 0
pdf_push(cw(), @n, 924)
Else
pdf_push(cw(), @n, 901)
EndIf
pdf_bytes(bytes(), rS(k), rL(k), cw(), @n)
Case #PDF_CLASS_NUMERIC
pdf_push(cw(), @n, 902)
pdf_numeric(bytes(), rS(k), rL(k), cw(), @n)
EndSelect
Next k
If n > ArraySize(cw()) + 1
ProcedureReturn 0 ; dépassement (ne devrait pas arriver)
EndIf
; --- 4. Niveau de correction et dimensions
If Security < 0
If n + 1 <= 40
Security = 2
ElseIf n + 1 <= 160
Security = 3
ElseIf n + 1 <= 320
Security = 4
Else
Security = 5
EndIf
EndIf
ecCount = 1 << (Security + 1)
need = n + 1 + ecCount ; longueur + données + correction
If need > 928
ProcedureReturn 0 ; texte trop long
EndIf
maxw = 0
If MaxWidth > 0
maxw = MaxWidth / ModuleW ; largeur max en modules
EndIf
If Columns > 0
c = Columns
Else
; plus petit nombre de colonnes qui donne un symbole au moins 2 fois plus large que haut,
; sans dépasser la largeur maximale
best = 0
For c = 1 To 30
rows = (need + c - 1) / c
If rows < 3 : rows = 3 : EndIf
If rows > 90
Continue
EndIf
w = 17 * c + 69
If maxw > 0 And w + 2 * QuietZone > maxw
Break
EndIf
best = c
If rows * RowRatio <= w / 2
Break
EndIf
Next c
c = best
EndIf
If c < 1
ProcedureReturn 0 ; ne tient pas dans la largeur demandée
EndIf
rows = (need + c - 1) / c
If rows < 3 : rows = 3 : EndIf
If rows > 90
ProcedureReturn 0
EndIf
; --- 5. Assemblage : longueur + données + bourrage (900)
pad = rows * c - need
total = rows * c
Dim allw.i(total - 1)
allw(0) = n + 1 + pad
For i = 0 To n - 1
allw(i + 1) = cw(i)
Next i
For i = 0 To pad - 1
allw(n + 1 + i) = 900
Next i
; --- 6. Correction d'erreurs Reed-Solomon sur GF(929), racines 3^1..3^k
Dim g.i(ecCount) ; coefficients croissants du générateur
g(0) = 1 : deg = 0 : a = 1
For i = 1 To ecCount
a = (a * 3) % 929
For j = deg + 1 To 0 Step -1
If j > deg : t = 0 : Else : t = g(j) : EndIf
If j > 0 : prev = g(j - 1) : Else : prev = 0 : EndIf
g(j) = ((prev - (a * t) % 929) % 929 + 929) % 929
Next j
deg + 1
Next i
Dim e.i(ecCount - 1)
For i = 0 To total - ecCount - 1
t = (allw(i) + e(ecCount - 1)) % 929
For j = ecCount - 1 To 0 Step -1
If j > 0 : prev = e(j - 1) : Else : prev = 0 : EndIf
e(j) = (prev + 929 - (t * g(j)) % 929) % 929
Next j
Next i
For i = 0 To ecCount - 1
t = e(ecCount - 1 - i)
If t > 0
t = 929 - t
EndIf
allw(total - ecCount + i) = t
Next i
; --- 7. Dessin
symW = 17 * c + 69 ; départ + indicateur + données + indicateur + arrêt
imgW = (symW + 2 * QuietZone) * ModuleW
imgH = (rows * RowRatio + 2 * QuietZone) * ModuleW
h = RowRatio * ModuleW
img = CreateImage(#PB_Any, imgW, imgH, 24, backcolor)
If img
If StartDrawing(ImageOutput(img))
For i = 0 To rows - 1
cl = i % 3
c30 = 30 * (i / 3)
Select cl
Case 0
L = c30 + (rows - 1) / 3
R = c30 + c - 1
Case 1
L = c30 + Security * 3 + (rows - 1) % 3
R = c30 + (rows - 1) / 3
Case 2
L = c30 + c - 1
R = c30 + Security * 3 + (rows - 1) % 3
EndSelect
y = (QuietZone + i * RowRatio) * ModuleW
x = QuietZone
x = pdf_drawPattern(#PDF_START, 17, x, y, h, ModuleW, color)
x = pdf_drawPattern(PeekL(?PDF_Codes + (cl * 929 + L) * 4), 17, x, y, h, ModuleW, color)
For j = 0 To c - 1
x = pdf_drawPattern(PeekL(?PDF_Codes + (cl * 929 + allw(i * c + j)) * 4), 17, x, y, h, ModuleW, color)
Next j
x = pdf_drawPattern(PeekL(?PDF_Codes + (cl * 929 + R) * 4), 17, x, y, h, ModuleW, color)
x = pdf_drawPattern(#PDF_STOP, 18, x, y, h, ModuleW, color)
Next i
StopDrawing()
EndIf
EndIf
ProcedureReturn img
EndProcedure