[Harbour-users] Anyone know of a Clipper BARCODE funcs?
Massimo Belgrano
mbelgrano at deltain.it
Sun Jan 31 06:11:40 EST 2010
here a visual fox pro solution more compatible with harbour
*-----------------------------------------------------------
* Conversion VB --> VFP : Emile MAITREJEAN www.emsystems.be
*-----------------------------------------------------------
* Entrée : lcChaine
*
* Retour : * w_code128 qui, affichée avec la police CODE128.TTF, donne
le code barre
* * une chaine vide si paramètre fourni incorrect
code128 = ""
IF LEN(lcChaine) > 0
* Vérifier si caractères valides
FOR lni = 1 TO LEN(lcChaine)
IF ASC(SUBSTR(lcChaine, lni, 1)) >= 32 AND ASC(SUBSTR(lcChaine, lni,
1)) <= 126
ELSE
lni = 0
EXIT
ENDIF
ENDFOR
* Calculer la chaine de code en optimisant l'usage des tables B et C
code128 = ""
tableB = .T.
IF lni > 0
lni = 1 &&lni devient l'index sur la chaine
DO WHILE lni <= LEN(lcChaine)
IF tableB
* Voir si intéressant de passer en table C
* Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres
minlni = IIF(lni = 1 OR lni + 3 = LEN(lcChaine), 4, 6)
*============= DO testnum
*============= IF minlni < 0 && Choix table C
IF lni = 1 && Débuter sur table C
code128 = CHR(210)
ELSE && Commuter sur table C
code128 = code128+CHR(204)
ENDIF
tableB = .F.
ELSE
IF lni = 1
code128 = CHR(209) && Débuter sur table B
ENDIF
ENDIF
ENDIF
IF NOT tableB Then
* On est sur la table C, essayer de traiter 2 chiffres
minlni = 2
*============= DO testnum
*============= IF minlni < 0 && OK pour 2 chiffres, les traiter
dummy = Val(SUBSTR(lcChaine, lni, 2))
dummy = IIF(dummy < 95, dummy + 32, dummy + 100)
code128 = code128+CHR(dummy)
lni = lni + 2
ELSE && On n'a pas 2 chiffres, repasser en table B
code128 = code128+CHR(205)
tableB = .T.
ENDIF
ENDIF
IF tableB
* Traiter 1 caractère en table B
code128 = code128+SUBSTR(lcChaine, lni, 1)
lni = lni + 1
ENDIF
ENDDO
* Calcul de la clé de contrôle
FOR lni = 1 TO LEN(code128)
dummy = ASC(SUBSTR(code128, lni, 1))
dummy = IIF(dummy < 127, dummy - 32, dummy - 100)
IF lni = 1
CheckSum = dummy
ELSE
CheckSum = MOD((CheckSum + (lni - 1) * dummy),103)
ENDIF
ENDFOR
* Calcul du code ASCII de la clé
CheckSum = IIF(CheckSum < 95, CheckSum + 32, CheckSum + 100)
* Ajout de la clé et du STOP
code128 = code128+CHR(CheckSum)+CHR(211)
ENDIF
ENDIF
w_code128 = code128
RETURN
FUNCTION testnum
* si les minlni caractères à partir de lni sont numériques, alors minlni=0
minlni = minlni - 1
IF lni + minlni <= LEN(lcChaine)
DO WHILE minlni >= 0
IF ASC(SUBSTR(lcChaine, lni + minlni, 1)) < 48 OR
ASC(SUBSTR(lcChaine, lni + minlni, 1)) > 57
EXIT
ENDIF
minlni = minlni - 1
ENDDO
ENDIF
ENDFUNC
2010/1/31 Massimo Belgrano <mbelgrano at deltain.it>:
> One way for printing barcode code 128 symbologies is use font
> here you can find a open source solution
> http://sourceforge.net/projects/openbarcodes/
> here a commercial solution http://www.barcodesoft.com/code128_font.aspx
>
> Folllow a untested sample
>
> oPrn := win_prn():New(GetDefaultPrinter())
> oPrn:SetFont("code128",11,,,,255) // please try different value
> oPrn:TextOut("ÑABC!Ó",.t.) // TEXT ready to TO PRINT
> oPrn:TextOut(code128("ABC"),.t.) // TEXT TO PRINT IF YOU HAVE CONVERT FUNC
> oPrn:NewPage()
>
>
> follow is vb function to convert
> please share here your result
>
> Public Function code128$(chaine$)
> 'Cette fonction est régie par la Licence Générale Publique Amoindrie
> GNU (GNU LGPL)
> 'This function is governed by the GNU Lesser General Public License (GNU LGPL)
> 'V 2.0.0
> 'Paramètres : une chaine
> 'Parameters : a string
> 'Retour : * une chaine qui, affichée avec la police CODE128.TTF,
> donne le code barre
> ' * une chaine vide si paramètre fourni incorrect
> 'Return : * a string which give the bar code when it is dispayed
> with CODE128.TTF font
> ' * an empty string if the supplied parameter is no good
> Dim i%, checksum&, mini%, dummy%, tableB As Boolean
> code128$ = ""
> If Len(chaine$) > 0 Then
> 'Vérifier si caractères valides
> 'Check for valid characters
> For i% = 1 To Len(chaine$)
> Select Case Asc(Mid$(chaine$, i%, 1))
> Case 32 To 126, 203
> Case Else
> i% = 0
> Exit For
> End Select
> Next
> 'Calculer la chaine de code en optimisant l'usage des tables B et C
> 'Calculation of the code string with optimized use of tables B and C
> code128$ = ""
> tableB = True
> If i% > 0 Then
> i% = 1 'i% devient l'index sur la chaine / i% become the string index
> Do While i% <= Len(chaine$)
> If tableB Then
> 'Voir si intéressant de passer en table C / See if
> interesting to switch to table C
> 'Oui pour 4 chiffres au début ou à la fin, sinon pour 6
> chiffres / yes for 4 digits at start or end, else if 6 digits
> mini% = IIf(i% = 1 Or i% + 3 = Len(chaine$), 4, 6)
> GoSub testnum
> If mini% < 0 Then 'Choix table C / Choice of table C
> If i% = 1 Then 'Débuter sur table C / Starting with table C
> code128$ = Chr$(210)
> Else 'Commuter sur table C / Switch to table C
> code128$ = code128$ & Chr$(204)
> End If
> tableB = False
> Else
> If i% = 1 Then code128$ = Chr$(209) 'Débuter sur table B /
> Starting with table B
> End If
> End If
> If Not tableB Then
> 'On est sur la table C, essayer de traiter 2 chiffres / We
> are on table C, try to process 2 digits
> mini% = 2
> GoSub testnum
> If mini% < 0 Then 'OK pour 2 chiffres, les traiter / OK for
> 2 digits, process it
> dummy% = Val(Mid$(chaine$, i%, 2))
> dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 105)
> code128$ = code128$ & Chr$(dummy%)
> i% = i% + 2
> Else 'On n'a pas 2 chiffres, repasser en table B / We
> haven't 2 digits, switch to table B
> code128$ = code128$ & Chr$(205)
> tableB = True
> End If
> End If
> If tableB Then
> 'Traiter 1 caractère en table B / Process 1 digit with table B
> code128$ = code128$ & Mid$(chaine$, i%, 1)
> i% = i% + 1
> End If
> Loop
> 'Calcul de la clé de contrôle / Calculation of the checksum
> For i% = 1 To Len(code128$)
> dummy% = Asc(Mid$(code128$, i%, 1))
> dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 105)
> If i% = 1 Then checksum& = dummy%
> checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
> Next
> 'Calcul du code ASCII de la clé / Calculation of the checksum ASCII code
> checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 105)
> 'Ajout de la clé et du STOP / Add the checksum and the STOP
> code128$ = code128$ & Chr$(checksum&) & Chr$(211)
> End If
> End If
> Exit Function
> testnum:
> 'si les mini% caractères à partir de i% sont numériques, alors mini%=0
> 'if the mini% characters from i% are numeric, then mini%=0
> mini% = mini% - 1
> If i% + mini% <= Len(chaine$) Then
> Do While mini% >= 0
> If Asc(Mid$(chaine$, i% + mini%, 1)) < 48 Or Asc(Mid$(chaine$,
> i% + mini%, 1)) > 57 Then Exit Do
> mini% = mini% - 1
> Loop
> End If
> Return
> End Function
>
>
>
> 2010/1/31 smu johnson <smujohnson at gmail.com>:
>> Hi.
>>
>> I've been Googling around for a solution to implement CODE128 (a b or c)
>> barcodes... and haven't really found much. Most of the stuff is
>> undocumented, and the only free Clipper one I found doesn't say what Barcode
>> standard it is. Added to this futility, is the fact that the Internet does
>> not seem to contain a simple .PDF or document that actually details the
>> CODE128 standard!
>>
>> Then I thought, maybe I should just ask here. Maybe this is a sign / omen
>> that someone here already knows of a free solution for this.
>>
>> PS: I'm just trying to output barcodes to a DoxMatrix type string.
>>
>> Thanks in advance
>> --
>> smu johnson <smujohnson at gmail.com>
>> _______________________________________________
>> Harbour-users mailing list (attachment size limit: 40KB)
>> Harbour-users at harbour-project.org
>> http://lists.harbour-project.org/mailman/listinfo/harbour-users
>>
>
>
>
> --
> Massimo Belgrano
>
> Iscritto all'albo dei CTU presso il Tribunale di Novara per materia Informatica
> Delta Informatica S.r.l. (http://www.deltain.it/) (+39 0321 455962)
> Analisi e sviluppo software per Lan e Web - Consulenza informatica - Formazione
>
--
Massimo Belgrano
Iscritto all'albo dei CTU presso il Tribunale di Novara per materia Informatica
Delta Informatica S.r.l. (http://www.deltain.it/) (+39 0321 455962)
Analisi e sviluppo software per Lan e Web - Consulenza informatica - Formazione
More information about the Harbour-users
mailing list