Search  
Wednesday, January 20, 2021 ..:: Forum ::.. Register  Login
 Forum Minimize
Pentru a putea posta mesaje trebuie să vă înregistraţi.
Notă: Mesajele cu conţinut jignitor sau ilegal (inclusiv cereri de soft piratat) nu sunt acceptate şi vor fi şterse imediat .

Pentru a primi raspunsuri rapide si corecte, scrieti in mesaj ce intentionati sa faceti, ce mesaj de eroare primiti, in ce context si in urma caror actiuni. De asemenea, mentionati versiunea de FoxPro in care lucrati!
Dacă nu specificați versiunea, se consideră VFP 9.0 SP2.

SearchForum Home
  Visual FoxPro  Visual FoxPro in general  codul de bare p...
 codul de bare pentru ordinele de plata
 
 2/20/2009 9:11:13 PM
User is offlinePROFOX
47 posts


codul de bare pentru ordinele de plata
 (N/A)
As dori sa editez ordinele de plata pentru banci, dar nu cunosc algoritmul pentru generarea codului de bare. Lucrez in VFP9. V-as fi recunoscatoare daca m-ati putea ajuta. Va multumesc!
 2/21/2009 8:17:45 AM
User is offlineCostel
332 posts
www.adrisoft.ro
3rd




Re: codul de bare pentru ordinele de plata
 (N/A)
Din ce-am gasit si eu pe internet, vezi in attachment  Ar fi interesant sa ne spui si la ce rezultat ai ajuns




Nu munci atit de mult incit sa nu-ti mai ramina timp ca sa cistigi bani. (proverb evreiesc)
PDF417(Nor de puncte).zip 
 2/21/2009 4:42:49 PM
User is offlinePROFOX
47 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Din pacate nu pot dezarhiva arhiva, winrar imi da mesajul  'damage'. Pot sa mai fac ceva?
 2/22/2009 12:49:17 AM
User is offlinejohny25
70 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Eu am dezarhivat fisierul cu WINZIP si a mers fara probleme.
 2/22/2009 1:09:23 AM
User is offlineGhiorghiu Bogdan
929 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A)
Are 0 kb!

Ghiorghiu Bogdan >>> Dacă tot te apuci să faci o treabă, fă-o bine de la inceput!
 2/22/2009 8:26:31 AM
User is offlineCostel
332 posts
www.adrisoft.ro
3rd




Re: codul de bare pentru ordinele de plata
 (N/A) Modified By Costel  on 2/22/2009 8:30:07 AM)
Sper ca de data asta sa fie bine


Na !  ca nu e bine   :(


Atunci voi "lipi" codul aici  

*
* Codifica un text in codul PDF 417 - folosit pentru  "norul de puncte"
* in declaratiile la MF, OP-uri pt salarii, Foi de varsamant
*
* Pompei Avram     20.04.2006 08:58:34
*
*
*    http://grandzebu.net/index.php    PDF417
*    Decodificator: http://www.intelcom.ru/download/decode/Decode417Demo.zip
*
*
*
*
* parametrii de intrare
*            textul de decodificat
*            numarul de coloane
* returneaza
*            sir codificat in PDF-417, care se va tipari cu fontul "Code PDF417"
*
*
*
* Exemplu de apel: (din OP.PRG)        Any2Txt este o functie care returneaza intotdeauna text
*
*
*             sir_pt_codificare =  Any2Txt(Any2Txt(NR))+","    ;
*                                 +Any2Txt(SUMA)         +","    ;
*                                 +Any2Txt(PLATITOR)     +","    ;
*                                 +Any2Txt(CUI_PLATIT) +","    ;
*                                 +Any2Txt(ADRESA)     +","    ;
*                                 +Any2Txt("")         +","    ;
*                                 +Any2Txt("")         +","    ;
*                                 +Any2Txt(BENEFICIAR) +","    ;
*                                 +Any2Txt(CUI_BENEFI) +","    ;
*                                 +Iba2Txt(IBAN_BENEF) +","    ;
*                                 +Any2Txt(BIC_BENEFI) +","    ;
*                                 +                    ","        ;
*                                 +Any2Txt(REPREZENTI) +","    ;
*                                 +StrTran(DToc(DATA),".","/")
*
*
*
*             * PDF-417 - MC 13.04.2006 10:17:38
*             *Sir_Codificat = pdf417( sir_pt_codificare, nrLin417, nrCol417)
*             *
*             Sir_Codificat = pdf417( sir_pt_codificare, 6)
*
*
*
*    18/08/08 16:49:36    M.Cazac     - "public domain"
*
function pdf417
parameters textToEncode,  cols

* textToEncode    && textul pe care il vom codifica
* rows            && nr. de linii
* cols            && nr. de coloane

rows = 10        && pt compatib cu vers anterioara
                && mai nou si le calculeaza el singur

private i, j


*
* punem spatii la sf. textului pe care trebuie sa-l codificam
* pana cand lungimea textului este multiplu de 6
*

do while (mod(len(textToEncode), 6) != 0)
    textToEncode = textToEncode + " "
endDo


*
* transormam "#" in "-" si "," in ":" si "/" in "+"
* prima data facem din ":" -> ";" si "-" -> " " si "+" in "*"
*
*
*textToEncode = strtran(textToEncode, "+", "*")
*textToEncode = strtran(textToEncode, ":", ";")
*textToEncode = strtran(textToEncode, "-", " ")
*textToEncode = strtran(textToEncode, "#", "-")
*textToEncode = strtran(textToEncode, ",", ":")
*textToEncode = strtran(textToEncode, "/", "+")


*? "'" + textToEncode + "'"
*? len(textToEncode)


public dimension CWs[1]
CWs[1] = .F.
public dimension RSCWs[1]
public dimension CWMatrix[1]



* Table des coefficients pour le niveau 0 / Factor table for level 0
* 27 917

public dimension RS0[2]

RS0[1] = 27
RS0[2] = 917


*Table des coefficients pour le niveau 1 / Factor table for level 1
* 522 568 723 809
*

public dimension RS1[4]

RS1[1] = 522
RS1[2] = 568
RS1[3] = 723
RS1[4] = 809


* Factor table for level 2
* 237 308 436 284 646 653 428 379
public dimension RS2[8]        && factorii Reed Solomon pentru nivelul de securitate 2
RS2[1] = 237
RS2[2] = 308
RS2[3] = 436
RS2[4] = 284
RS2[5] = 646
RS2[6] = 653
RS2[7] = 428
RS2[8] = 379

* Factor table for level 3
* 274 562 232 755 599 524 801 132 295 116 442 428 295  42 176  65
public dimension RS3[16]        && factorii Reed Solomon pentru nivelul de securitate 3
RS3[1] = 274
RS3[2] = 562
RS3[3] = 232
RS3[4] = 755
RS3[5] = 599
RS3[6] = 524
RS3[7] = 801
RS3[8] = 132
RS3[9] = 295
RS3[10] = 116
RS3[11] = 442
RS3[12] = 428
RS3[13] = 295
RS3[14] = 42
RS3[15] = 176
RS3[16] = 65



* 361 575 922 525 176 586 640 321 536 742 677 742 687 284 193 517
* 273 494 263 147 593 800 571 320 803 133 231 390 685 330  63 410
public dimension RS4[32]        && factorii Reed Solomon pentru nivelul de securitate 4



RS4[1] = 361
RS4[2] = 575
RS4[3] = 922
RS4[4] = 525
RS4[5] = 176
RS4[6] = 586
RS4[7] = 640
RS4[8] = 321
RS4[9] = 536
RS4[10] = 742
RS4[11] = 677
RS4[12] = 742
RS4[13] = 687
RS4[14] = 284
RS4[15] = 193
RS4[16] = 517

RS4[17] = 273
RS4[18] = 494
RS4[19] = 263
RS4[20] = 147
RS4[21] = 593
RS4[22] = 800
RS4[23] = 571
RS4[24] = 320
RS4[25] = 803
RS4[26] = 133
RS4[27] = 231
RS4[28] = 390
RS4[29] = 685
RS4[30] = 330
RS4[31] = 63
RS4[32] = 410



=getByteEnc(textToEncode)
* ? "CWs ============"
* for i = 1 to aLen(CWs)
*     ??int(CWs[i])
* endFordmf

* wait wind "data CW"

private errLevel
*19.01.2007 09:51:21
*errLevel = 2        && Cu asta a dus Pompei o FV si a fost OK
* 13/02/2008 06:08:20
errLevel = 3

*
* stim rows, cols cate se doresc
* cols ramane fix si rows il calculam noi
*
* stim cate CWs de date avem sa zicem a
* a + 1 (CW de trecere in byte) + 1 (nr. de CW) + s (nr. de CW de corectie)
* s = 2 ^ (errLevel + 1)

private xCWs    && nr total de CWs

xCWs = aLen(CWs) + 1  + 2^(errLevel + 1)

*
* calculam nr. de linii de care avem nevoie
* xCWs / cols
*

rows = ceiling(xCWs / cols)

*
* cate CW de padding punem ?
*
private nrPadCW

nrPadCW = rows * cols - xCWs

*
* punem CW de padding (900) in array-ul de CW de date (CWs)
*
private oldCWNr
oldCWNr = aLen(CWs)
dimension CWs[oldCWNr + nrPadCW]

for i = oldCWNr + 1 to oldCWNr + nrPadCW
    CWs[i] = 900
endFor

* 2006-04-17
*
* punem si nr. de CWs
*

oldCWNr = aLen(CWs)
dimension CWs[oldCWNr + 1]
for i = oldCWNr to 1 step -1
    CWs[i+1] = CWs[i]
endFor
CWs[1] = oldCWNr + 1

*
* gata - am pus si nr. de CWs
*

=createRSCW(errLevel)
*? "RSCWs =========="
*for i = 1 to aLen(RSCWs)
*    ??int(RSCWs[i])
*endFor


private retStr
retStr = ""

private kContinuam
kContinuam = crCWMatrix(rows, cols, errLevel)
if kContinuam then
    *    wait wind " "
    *     ? "Matrix ========="
    *     for i = 1 to rows
    *         ?
    *         for j = 1 to cols + 2
    *             ?? CWMatrix[i,j]
    *         endFor
    *     endFor
    *     wait wind "matricea"
    *     ? "getBinaryCW"
    *     ?getBinaryCW(1, 1)
    *     ?getBinaryCW(1, 2)
    *     ?getBinaryCW(1, 3)
    *
    *     ? "get10from2"
    *     ?get10from2("1010")
    *     ?get10from2("0111")
    *
    *     ? "stringul"
*
    retStr = getFontString()
*     ?retStr

     private ofh
     ofh = fCreate("c:\pdf417.txt")
     =fPuts(ofh, retStr)
     =fClose(ofh)
endIf

return (retStr)    && PDF417
***********************************************************************************************
***********************************************************************************************
***********************************************************************************************
***********************************************************************************************

*
* Codifica in mod byte
*
function getByteEnc
parameters textToEncode
private retCode

*
* In mod BYTE putem codifica 256 de caractere adica tot setul de caractere ASCII extins
* Daca numarul bytes-lor este multiplu de 6 vom folosi CW 924 pentru a trece in modul de
* codificare BYTE daca nu vom folosi CW 901.
*
* Codificarea consta in transformarea a 6 bytes in baza 256 in 5 CW in baza 900.
* Pentru a face acest lucru vom proceda astfel:
*     1. Luam din textul primit grupuri de cate 6 (X5X4X3X2X1X0)
*     2. Calculam suma S = X5 * 256^5 + X4 * 256^4 + X3 * 256^3 + X2 * 256^2 + X1 * 256 + X0
*     3. Calculam CWs : CW0 = S mod 900, S = S \ 900, CW1 = S mod 900 ...
*     4. CW0 este CW cel mai insignifiant adica textul codificat va fi CW4CW3CW2CW1CW0
*     5. Bytes-ii ce raman dupa conversia grupurilor de cate 6 sun luati asa cum sunt 1 byte = 1 CW
*
* Exemplu 1
* Text de codificat: alcool
* Secventa de bytes (in ASCII) este : 97, 108, 99, 111, 111, 108
* S = 97 x 2565 + 108 x 2564 + 99 x 2563 + 111 x 2562 + 111 x 256 + 108 = 107 118 152 609 644
* CW0 = 107 118 152 609 644 MOD 900 = 244
* S = 107 118 152 609 644 \ 900 = 119 020 169 566
* CW1 = 119 020 169 566 MOD 900 = 766
* S = 119 020 169 566 \ 900 = 132 244 632
* CW2 = 132 244 632 MOD 900 = 432
* S = 132 244 632 \ 900 = 146 938
* CW3 = 146 938 MOD 900 = 238
* S = 146 938 \ 900 = 163
* CW4 = 163 MOD 900 = 163
* Secventa incluzand switch-ul este : 924, 163, 238, 432, 766, 244
*
* Exemplu 2
* Text de codificat: alcoolique
*
* Secventa de bytes (in ASCII) este : 97, 108, 99, 111, 111, 108, 105, 113, 117, 101
* Primii 6 bytes sun codificati ca mai sus si adaugam 105, 113, 117 si 101
* Secventa incluzand switch-ul este  : 901, 163, 238, 432, 766, 244, 105, 113, 117, 101
*

private textLen && nr. de caractere ale textului
textLen = len(textToEncode)


*
* Verificam daca numarul caracterelor din textul primit este multiplu de 6 sau nu
* si in functie de acest lucru putem switch-ul de trecere in mod BYTE
*
if (mod(textLen, 6) = 0) then
    = addCW(924)
    *= addCW(901)
else
    *= addCW(901)
    = addCW(924)
endIf

private nrGroups && numarul de grupuri de cate 6 caractere
nrGroups = int(textLen / 6)

* luam grupurile pe rand si le codificam
private i        && iterator
private grText    && textul unui grup de 6 caractere
private grVal    && valoarea numerica dupa calularea sumei (ASCII)
private CW0, CW1, CW2, CW3, CW4

for i = 1 to nrGroups
    grText = subStr(textToEncode, ((i - 1) * 6 + 1), 6)
    grVal = asc(subStr(grText, 1, 1)) * 256^5        ;
            + asc(subStr(grText, 2, 1)) * 256^4        ;
            + asc(subStr(grText, 3, 1)) * 256^3        ;
            + asc(subStr(grText, 4, 1)) * 256^2        ;
            + asc(subStr(grText, 5, 1)) * 256^1        ;
            + asc(subStr(grText, 6, 1)) * 256^0

    CW0 = mod(grVal, 900)
    grVal = int(grVal / 900)
    CW1 = mod(grVal, 900)
    grVal = int(grVal / 900)
    CW2 = mod(grVal, 900)
    grVal = int(grVal / 900)
    CW3 = mod(grVal, 900)
    grVal = int(grVal / 900)
    CW4 = mod(grVal, 900)

    = addCW(CW4)
    = addCW(CW3)
    = addCW(CW2)
    = addCW(CW1)
    = addCW(CW0)
endFor

if (len(textToEncode) > 6 * nrGroups)
    * luam ce a mai ramas dupa grupurile de 6 si adaugam ca CWs direct valorile lor in ASCII

    *= addCW(913)    && punem un cod de trecere in byte
    *wait window "aici nu mai ajungem"
    for i = (6 * nrGroups) + 1 to len(textToEncode)
        * = addCW(913)    && punem un cod de trecere in byte
        retCode = addCW(asc(subStr(textToEncode, i, 1)))
    endFor
endIf



return && getByteEnc

*
* Codifica in mod text
*
function getTextEnc
parameters textToEncode
private retCode

return && getTextEnc

*
* Codifica in mod numeric
*
function getNumEnc
parameters textToEncode
private retCode

return && getNumEnc


*
* Adauga un CW la sirul de CWs
*
function addCW
parameters newCW

if ((aLen(CWs) = 1) and (type("CWs[1]") = "L")) then
    * inca nu a fost creat array-ul
    CWs[1] = newCW
else
    * marim array-ul cu 1 si adaugam noul element
    private k
    k = aLen(CWs)
    dimension CWs(k+1)
    CWs[k+1] = newCW
EndIf
   
return && addCW

*
* Creaza CW-urile de detectie si corectie a erorilor
*
function createRSCW
parameters level    && nivelul de corectie folosit (intre 2 si 8)

private RSArray        && care sir de factori RS este folosit
RSArray    = "RS" + str(level,1,0)

*wait wind RSArray

private m    && cate CW avem
m = aLen(CWs)

private k    && cate CW de corectie o sa avem
k = 2^(level + 1)

private t    && variabila temporara
t = 0

private i, j    && iteratori

dimension RSCWs[k]    && array cu CW de corectie
for i = 1 to k
    RSCWs[i] = 0
endFor

for i = 1 to m
    t = mod(CWs[i] + RSCWs[k], 929)
    for j = k to 1 step - 1
        factors = RSArray + "[" + str(j,3,0) + "]"
        if j = 1 then
            RSCWs[j] = mod(mod((929 - (t * &factors)), 929), 929)
        else
            RSCWs[j] = mod(mod((RSCWs[j-1] + 929 - (t * &factors)), 929), 929)
        endIf
    endFor
endFor

* private t1, t2, t3
* t1 = 0
* t2 = 0
* t3 = 0
*
* for i = m to 1 step -1
*     t1 = mod(CWs[i] + RSCWs[k], 929)
*
*     for j = k to 2 step - 1
*         factors = RSArray + "[" + str(j,3,0) + "]"
*
*         t2 = mod(t1 * &factors, 929)
*         t3 = 929 - t2
*         RSCWs[j] = mod(RSCWs[j-1] + t3, 929)
*
*         * RSCWs[j] = mod(mod((929 - (t * &factors)), 929), 929)
*     endFor
*
*     factors = RSArray + "[1]"
*     t2 = mod(t1 * &factors, 929)
*     t3 = 929 - t2
*     RSCWs[1] = mod(t3, 929)
* endFor
*

for j=1 to k
    if RSCWs[j] <> 0 then
        RSCWs[j] = 929 - RSCWs[j]
    endIf
endFor



return    &&createRSCW

*
* Dupa ce avem CW-urile rezultate din date si pe cele de detectie si corectie a erorilor
* construim matricea (punem si Lx si Rx)
* O linie este compusa dintr-un caracter de START, un CW de parte stanga, CWs de date, un CW de parte
* dreapta si un caracter de STOP
* S = START
* Lx= indicator stanga pt linia x
* Rx= indicator dreapta pt linia x
* P = STOP
*
* Indicatorii contin: numarul liniei, numarul de linii, nivelul de securitate, si numarul de coloane de date.
* Nu fiecare linie contine toate aceste informatii. Informatiile se desfasoara pe cate 3 linii si se repeta.
*
* Linia 0:    Stanga R.I. (Nr. liniei, Nr. de linii)           Dreapta R.I. (Nr. liniei, Nr. de coloane)
* Linia 1:    Stanga R.I. (Nr. liniei, Niv. de Securitate)    Dreapta R.I. (Nr. liniei, Nr. de linii)
* Linia 2:    Stanga R.I. (Nr. liniei, Nr. de coloane)        Dreapta R.I. (Nr. liniei, Niv. de Securitate)
*
*
* Indicatorii stanga
*
* Linia 0  30 * (nr. liniei div 3) + ((nr. de linii - 1) div 3)
* Linia 1  30 * (nr. liniei div 3) + niv. de securitate * 3 + (nr. de linii - 1) mod 3
* Linia 2  30 * (nr. liniei div 3) + (nr. de coloane - 1)
*

function crCWMatrix
parameters rows, cols, errLevel

*
* In CWs[]        avem CW ce contin datele utile
* In RSCWs[]    avem CW ce contin codurile pt. detectia si corectia erorilor
* Primul CW va fi numarul CWs ( nr CW + el insusi (1) + CW pt padding)
* Pt. padding vom folosi un CW cu functie speciala (900 de exemplu)
* Trebuie sa le impartim in linii si coloane
*
dimension tempCWMatrix[rows, cols]        && fara Lx si Rx
dimension CWMatrix[rows, cols + 2]        && cu Lx si Rx
private i, j, nrDataCWs, nrRSCWs

nrDataCWs    = aLen(CWs)
nrRSCWs        = aLen(RSCWs)

*
* testam daca dimensiunea matricii(numarul de linii si coloane primit ca parametru)
* este destul de incapatoare pentru cate CWs avem noi
*

* Pompei
*if (rows * cols) < (nrDataCWs + nrRSCWs)
*
*    return (.F.)
*endIf


*
* Prima data se pune numarul CWs apoi CWs de date apoi CWs de paddin si la urma CWs de detectie / corectie
*
dimension AllCWs[rows * cols]

* l-am pus direct in CWs[] inainte de a calcula RSCWs
* AllCWs[1] = nrDataCWs + 1


* punem datele
*for i = 2 to (nrDataCWs + 1)
*    AllCWs[i] = int(CWs[i-1])
*endFor
*
* punem CW de detectie / corectie
*j = 0
*for i = (nrDataCWs + 2) to (rows * cols)
*    j = j + 1
*    * AllCWs[i] = int(RSCWs[j])
*    AllCWs[i] = int(RSCWs[nrRSCWs - j + 1])
*endFor

* punem datele
for i = 1 to (nrDataCWs)
    AllCWs[i] = int(CWs[i])
endFor

* punem CW de detectie / corectie
j = 0
for i = (nrDataCWs + 1) to (rows * cols)
    j = j + 1
    * AllCWs[i] = int(RSCWs[j])
    AllCWs[i] = int(RSCWs[nrRSCWs - j + 1])
endFor

* punem datele in matrice temporara
private iter
for i = 1 to rows
    for j = 1 to cols
        iter = ((i - 1) * cols + j)
        tempCWMatrix[i, j] = AllCWs[iter]
    endFor
endFor

* punem datele in matricea finala
for i = 1 to rows
    for j = 1 to cols
        CWMatrix[i, j+1] = tempCWMatrix[i, j]
    endFor
endFor

* punem Lx si Rx in matricea finala
*
* Indicatorii contin: numarul liniei, numarul de linii, nivelul de securitate, si numarul de coloane de date.
* Nu fiecare linie contine toate aceste informatii. Informatiile se desfasoara pe cate 3 linii si se repeta.
*
* Linia 0:    Stanga R.I. (Nr. liniei, Nr. de linii)           Dreapta R.I. (Nr. liniei, Nr. de coloane)
* Linia 1:    Stanga R.I. (Nr. liniei, Niv. de Securitate)    Dreapta R.I. (Nr. liniei, Nr. de linii)
* Linia 2:    Stanga R.I. (Nr. liniei, Nr. de coloane)        Dreapta R.I. (Nr. liniei, Niv. de Securitate)
*
*
* Indicatorii stanga
*
* Linia 0  30 * (nr. liniei div 3) + ((nr. de linii - 1) div 3)
* Linia 1  30 * (nr. liniei div 3) + niv. de securitate * 3 + (nr. de linii - 1) mod 3
* Linia 2  30 * (nr. liniei div 3) + (nr. de coloane - 1)
*

for i = 1 to rows
    * Linia 0
    if mod((i - 1),3) = 0
        * Lx - linia 0
        CWMatrix[i,1] = 30 * int((i-1) / 3) + int((rows - 1) / 3)
        * Rx - linia 0
        CWMatrix[i, cols +2] = 30 * int((i-1) / 3) + (cols - 1)
    endIf

    * Linia 1
    if mod((i - 1),3) = 1
        * Lx - linia 1
        CWMatrix[i,1] = 30 * int((i-1) / 3) + (errLevel * 3) + mod((rows - 1), 3)
        * Rx - linia 1
        CWMatrix[i, cols +2] = 30 * int((i-1) / 3) + int((rows - 1) / 3)
    endIf

    * Linia 2
    if mod((i - 1),3) = 2
        * Lx - linia 2
        CWMatrix[i,1] = 30 * int((i-1) / 3) + (cols - 1)
        * Rx - linia 2
        CWMatrix[i, cols +2] = 30 * int((i-1)/ 3) + (errLevel * 3) + mod((rows - 1), 3)
    endIf
   
endFor

return (.T.)    && crCWMatrix

*
* Returneaza reprezentarea binara a unui CW din unul din cele 3 fisiere
* care contin toate cele 929 CWs in format binar
*
function getBinaryCW
parameters CW, nrLinie
* CW        CW a carui reprezentare binara trebui sa o returnam
* nrLinie    nr. liniei in care se afla CW (in fc. de ac. nr. se alege unul din cele 3 fis cu CW binare)

private retVal
retVal = space(17)
dimension fis[3]
*
* Pompei - 2006 05 15 15:40
*
* La clienti nu avem drive-ul U
* Punem cele trei fisiere in PROJECTS
* Trebuie sa le punem si in actualizare
*
* fis[1] = "U:\POMPEI\FOX\table1.txt"
* fis[2] = "U:\POMPEI\FOX\table2.txt"
* fis[3] = "U:\POMPEI\FOX\table3.txt"

fis[1] = "table1.txt"
fis[2] = "table2.txt"
fis[3] = "table3.txt"

*
* la linia 1 folosim tabela 1
* la linia 2 folosim tabela 2
* la linia 3 folosim tabela 3
* la linia 4 folosim tabela 1
* la linia 5 folosim tabela 2
* la linia 6 folosim tabela 3
*
private fisName    && numele fisierului care contine tabela pe care o vom utiliza
do case
    case mod(nrLinie, 3) = 0
        fisName = fis[3]
    case mod(nrLinie, 3) = 1
        fisName = fis[1]
    case mod(nrLinie, 3) = 2
        fisName = fis[2]
endCase

private ifhTabela, i

ifhTabela = fOpen(fisName)

if ifhTabela > 0 then
    * am putut-o deschide
    * luam ce scrie pe linia cu nr. CW
    for i = 1 to CW + 1
        retVal = fGets(ifhTabela)
    endFor

    =fClose(ifhTabela)
endIf


return (retVal)    && getBinaryCW

*
* returneaza caracterul din fontul lui gz@grandzebu.net in functie de grupul
* de 5 biti pe care ii primeste
*
function getFontChar
parameters biti
dimension PDFfont[32]
PDFfont[1]    = 65
PDFfont[2]    = 66
PDFfont[3]    = 67
PDFfont[4]    = 68
PDFfont[5]    = 69
PDFfont[6]    = 70

PDFfont[7]    = 97
PDFfont[8]    = 98
PDFfont[9]    = 99

PDFfont[10]    = 100
PDFfont[11]    = 101
PDFfont[12]    = 102
PDFfont[13]    = 103
PDFfont[14]    = 104
PDFfont[15]    = 105
PDFfont[16]    = 106
PDFfont[17]    = 107
PDFfont[18]    = 108
PDFfont[19]    = 109

PDFfont[20]    = 110
PDFfont[21]    = 111
PDFfont[22]    = 112
PDFfont[23]    = 113
PDFfont[24]    = 114
PDFfont[25]    = 115
PDFfont[26]    = 116
PDFfont[27]    = 117
PDFfont[28]    = 118
PDFfont[29]    = 119

PDFfont[30]    = 120
PDFfont[31]    = 121
PDFfont[32]    = 122

private retVal, digiVal

digival = get10from2(biti) + 1    && 00000 este A care la noi este PDFfont[1]

retVal = chr(PDFfont[digiVal])


return retVal    && getFontChar


function get10from2
parameters baza2
*
* baza2 este format din 5 cifre binare (adiva 0 sau 1)
*

private baza10, i, nLen
baza10 = 0

nLen = len(baza2)

for i = nLen to 1 step -1
    baza10 = baza10 + val(substr(baza2, i, 1))*2^(nLen-i)
endFor

return baza10

*
* Returneaza stringul pe care il vom tipari cu fontul PDF417
*
function getFontString
private retVal
retVal = ""
* In CWMatrix avem CW finale
* fiecare CW din se transforma in binar cu getBinaryCW(CW, nrLinie)
* fiecare CW va avea 17 biti
* primul este tot timpul 1 iar ultimul este tot timpul 0 (deci ne facem ca nu-i vedem)
* restul ii impartim in 3 grupuri de cate 5 biti si fiecare grup de 5 biti
* il transformam in cate un caracter din fontul cel smecher cu getFontChar(biti)
*
* CW de start este in font +
* CW de stop este in font -
* grupurile de cate 5 biti ii separam cu cate un *
* deci o linie de matrice va arata asa : +*jdy*Ajf*BAe*-
*
private xDimMatrix, yDimMatrix, i, j

xDimMatrix = aLen(CWMatrix, 2)
yDimMatrix = aLen(CWMatrix, 1)

private retVal    && stringul ce codifica matricea cu CW in caractere din fontul PDF417
retVal = ""

private binCW    && reprezentarea binara a CW

for i = 1 to yDimMatrix
    * punem inceputul de line
    retVal = retVal + "+*"
    for j = 1 to xDimMatrix
        binCW = getBinaryCW(CWMatrix[i, j], i)
       
        retVal = retVal + getFontChar(subStr(binCW, 2, 5))
        retVal = retVal + getFontChar(subStr(binCW, 7, 5))
        retVal = retVal + getFontChar(subStr(binCW, 12, 5))

        * punem separatorul ("01" in binar)
        retVal = retVal + "*"
       
    endFor
    * punem sf. de linie si un ENTER
    retVal = retVal + "-" + chr(13) + chr(10)

endFor

return retVal    && getFontString





Nu munci atit de mult incit sa nu-ti mai ramina timp ca sa cistigi bani. (proverb evreiesc)
pdf417.txt 
 2/22/2009 1:59:03 PM
User is offlinePROFOX
47 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Am creat sirul de codificat (sir_pt_codificare) si am lansat functia PDF417 pe care mi-ati trimis-o, cu parametrii indicati, adica sir_codificat=PDF417(sir_pt_codificare,6). In primul rand mi-a dat eroare de compilare la prima instructiune PUBLIC DIMENSION CWs[1], respectiv syntax error. Am eliminat eroarea scotind PUBLIC de la toate instructiunile asemanatoare. In final mi s-a returnat un tabel in campul sir_tabel format din 5 linii si n coloane cu grupuri de AAA* . Ma mai puteti ajuta cu sfaturi sau cu ceva mai simplu?
 2/22/2009 9:03:14 PM
User is offlineedyshor
1450 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A) Modified By edyshor  on 2/23/2009 2:01:48 AM)
post dublu.
 2/22/2009 9:05:54 PM
User is offlineedyshor
1450 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A)
Nu functioeaza Costele, chiar si fupa ce scot "public" din "public dimension" ..

Pentru un exemplu de: ?pdf417("392,2008,77,,##,#X#,50000,1000,,2000,3000,300,4000*",3)
imi intoarce :
"
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
+*AAA*AAA*AAA*AAA*AAA*-
"
Ceeea ce .. nu e prea bine :(  Am gresit eu undeva la apelare?
Din programu lui "Grandzebu" ar trebuie sa iasa:
"
+*unk*psy*Anr*Ega*ypy*-
+*xcc*yso*ypk*mya*yos*-
+*ejA*vju*ica*Bgz*eDs*-
+*fxy*Cck*BnE*lvC*pwz*-
+*psE*ysm*ypk*ypk*psk*-
+*yrq*aiz*pjk*prw*xjq*-
+*dts*tog*urA*uvs*uiz*-
+*zdi*oxA*ypk*zgf*pzj*-
+*zdm*pjk*rFs*pjk*yno*-
+*csa*pvs*fls*aaC*csg*-
+*owE*lic*BjB*svm*owk*-
+*ocz*bBD*Cky*vyo*zct*-
"
Te ajuta sa-ti dai unde ar fi problema ?

 2/23/2009 2:06:58 AM
User is offlineedyshor
1450 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A) Modified By edyshor  on 2/23/2009 2:52:05 AM)

Am incercat sa portez si eu cdul ala din vb dar am dat-o in balarii, array-urile in vb incep de la 0, conversia dintr-un tip in altul se face automat (fara functii) iar functia de format nu stiu cat de compatibila e cu ce am gasit eu echivalent in vb. Rezultatul il postez in continuare dar va zic de acum ca nu merge, da altceva decat ar fi trebuit sa dea .. poate reuseste cineva sa-l repare ..

Nu merge .. dau paste aici la cod, dar e destul de mult..
*--------------------------------------------------------------

Clear

CodeErr = 0

text1 = "392,2008,77,,##,#X#,50000,1000,,2000,3000,300,4000*"

Secu = -1

nBcol = 0

CodeBarre = pdf417(@text1, @Secu, @nBcol, @CodeErr)

If CodeErr > 1 And CodeBarre = ""

? "Errror "+CodeErr+" : "+Icase(CodeErr=2,"Chaine contain too many datas, we go beyong the 928 MCs.",CodeErr=3,"Number of CWs per row too small, we go beyong 90 rows.","unknown")

Else

? "CodeBarre: "+Chr(13)+Chr(10)+CodeBarre

Endif

_Cliptext = CodeBarre

 

Function pdf417(Chaine, Secu, nBcol, CodeErr)

*!*Parameters : The string to encode.

*!* The hoped security level, -1 = automatic.

*!* The hoped number of data MC columns, -1 = automatic.

*!* A variable which will can retrieve an error number.

*!*Return : * a string which, printed with the PDF417.TTF font, gives the bar code.

*!* * an empty string if the given parameters aren&&t good.

*!* * secu% contain le really used security level.

*!* * NbCol% contain the really used number of data CW columns.

*!* * Codeerr% is 0 if no error occured, else :

*!* 0 : No error

*!* 1 : Chaine is empty

*!* 2 : Chaine contain too many datas, we go beyong the 928 CWs.

*!* 3 : Number of CWs per row too small, we go beyong 90 rows.

*!* 10 : The security level has being lowers not to exceed the 928 CWs. (It&&s not an error, only a warning.)

*-- variabile globale (huh!?)

Private i,j,k,IndexChaine, Dummy, xFlag

*-- splitting ino blocs

Private Array Liste[1]

Private IndexListe

IndexListe = 0

*-- data compaction

Private Longueur, ChaineMC, Total

ChaineMC = ""

*-- "text" mode processing

Private Array ListeT[1]

Private IndexListeT, CurTable, ChaineT, NewTable

*-- Reed Solomon codes

Private MCcorrection[1]

*-- Left and right side CWs

Private C1, C2, C3

*-- PROCEDURE routine QuelMode

Private Mode, CodeASCII

CodeASCII = 0

Mode = 0

*-- PROCEDURE routine Modulo

Private ChaineMod, Diviseur, ChaineMult, Nombre

*-- tables

Private pdf417

pdf417 = ""

*-- adugat de mine, e folosit mai jos

Private xAscii

*!*This string describe the ASCII code for the "text" mode.

*!*ASCII contain 95 fields of 4 digits which correspond to char. ASCII values 32 to 126. These fields are :

*!* 2 digits indicating the table(s) (1 or several) where this char. is located. (Table numbers : 1, 2, 4 and 8)

*!* 2 digits indicating the char. number in the table

*!* Sample : 0726 at the beginning of the string : The Char. having code 32 is in the tables 1, 2 and 4 at row 26

xAscii = ;

"072608100820041512180421041008280823082412220420"+;

"121312161217121904000401040204030404040504060407"+;

"040804091214080008010423080208250803010001010102"+;

"010301040105010601070108010901100111011201130114"+;

"011501160117011801190120012101220123012401250804"+;

"080508060424080708080200020102020203020402050206"+;

"020702080209021002110212021302140215021602170218"+;

"02190220022102220223022402250826082108270809"

Local Array CoefRS[9]

*!*CoefRS contain 8 strings describing the factors of the polynomial equations for the reed Solomon codes.

CoefRS[1] = "027917"

CoefRS[2] = "522568723809"

CoefRS[3] = "237308436284646653428379"

CoefRS[4] = "274562232755599524801132295116442428295042176065"

CoefRS[5] = ;

"361575922525176586640321536742677742687284193517"+;

"273494263147593800571320803133231390685330063410"

CoefRS[6] = ;

"539422006093862771453106610287107505733877381612"+;

"723476462172430609858822543376511400672762283184"+;

"440035519031460594225535517352605158651201488502"+;

"648733717083404097280771840629004381843623264543"

CoefRS[7] = ;

"521310864547858580296379053779897444400925749415"+;

"822093217208928244583620246148447631292908490704"+;

"516258457907594723674292272096684432686606860569"+;

"193219129186236287192775278173040379712463646776"+;

"171491297763156732095270447090507048228821808898"+;

"784663627378382262380602754336089614087432670616"+;

"157374242726600269375898845454354130814587804034"+;

"211330539297827865037517834315550086801004108539"

CoefRS[8] = ;

"524894075766882857074204082586708250905786138720"+;

"858194311913275190375850438733194280201280828757"+;

"710814919089068569011204796605540913801700799137"+;

"439418592668353859370694325240216257284549209884"+;

"315070329793490274877162749812684461334376849521"+;

"307291803712019358399908103511051008517225289470"+;

"637731066255917269463830730433848585136538906090"+;

"002290743199655903329049802580355588188462010134"+;

"628320479130739071263318374601192605142673687234"+;

"722384177752607640455193689707805641048060732621"+;

"895544261852655309697755756060231773434421726528"+;

"503118049795032144500238836394280566319009647550"+;

"073914342126032681331792620060609441180791893754"+;

"605383228749760213054297134054834299922191910532"+;

"609829189020167029872449083402041656505579481173"+;

"404251688095497555642543307159924558648055497010"

CoefRS[9] = ;

"352077373504035599428207409574118498285380350492"+;

"197265920155914299229643294871306088087193352781"+;

"846075327520435543203666249346781621640268794534"+;

"539781408390644102476499290632545037858916552041"+;

"542289122272383800485098752472761107784860658741"+;

"290204681407855085099062482180020297451593913142"+;

"808684287536561076653899729567744390513192516258"+;

"240518794395768848051610384168190826328596786303"+;

"570381415641156237151429531207676710089168304402"+;

"040708575162864229065861841512164477221092358785"+;

"288357850836827736707094008494114521002499851543"+;

"152729771095248361578323856797289051684466533820"+;

"669045902452167342244173035463651051699591452578"+;

"037124298332552043427119662777475850764364578911"+;

"283711472420245288594394511327589777699688043408"+;

"842383721521560644714559062145873663713159672729"

CoefRS[9] = CoefRS[9] + ;

"624059193417158209563564343693109608563365181772"+;

"677310248353708410579870617841632860289536035777"+;

"618586424833077597346269757632695751331247184045"+;

"787680018066407369054492228613830922437519644905"+;

"789420305441207300892827141537381662513056252341"+;

"242797838837720224307631061087560310756665397808"+;

"851309473795378031647915459806590731425216548249"+;

"321881699535673782210815905303843922281073469791"+;

"660162498308155422907817187062016425535336286437"+;

"375273610296183923116667751353062366691379687842"+;

"037357720742330005039923311424242749321054669316"+;

"342299534105667488640672576540316486721610046656"+;

"447171616464190531297321762752533175134014381433"+;

"717045111020596284736138646411877669141919045780"+;

"407164332899165726600325498655357752768223849647"+;

"063310863251366304282738675410389244031121303263"

Local Array CodageMC[3]

*!*CodageMC contain the 3 sets of the 929 MCs. Each MC is described in the PDF417.TTF font by 3 char. composing 3 time 5 bits. The first bit which is always 1

*!* and the last one which is always 0 are into the separator character.

CodageMC[1] = ;

"urAxfsypyunkxdwyozpDAulspBkeBApAseAkprAuvsxhypnk"+;

"utwxgzfDAplsfBkfrApvsuxyfnkptwuwzflspsyfvspxyftw"+;

"pwzfxyyrxufkxFwymzonAudsxEyolkucwdBAoksucidAkokg"+;

"dAcovkuhwxazdnAotsugydlkoswugjdksosidvkoxwuizdts"+;

"owydswowjdxwoyzdwydwjofAuFsxCyodkuEwxCjclAocsuEi"+;

"ckkocgckcckEcvAohsuayctkogwuajcssogicsgcsacxsoiy"+;

"cwwoijcwicyyoFkuCwxBjcdAoEsuCicckoEguCbcccoEaccE"+;

"oEDchkoawuDjcgsoaicggoabcgacgDobjcibcFAoCsuBicEk"+;

"oCguBbcEcoCacEEoCDcECcascagcaacCkuAroBaoBDcCBtfk"+;

"wpwyezmnAtdswoymlktcwwojFBAmksFAkmvkthwwqzFnAmts"+;

"tgyFlkmswFksFkgFvkmxwtizFtsmwyFswFsiFxwmyzFwyFyz"+;

"vfAxpsyuyvdkxowyujqlAvcsxoiqkkvcgxobqkcvcamfAtFs"+;

"wmyqvAmdktEwwmjqtkvgwxqjhlAEkkmcgtEbhkkqsghkcEvA"+;

"mhstayhvAEtkmgwtajhtkqwwvijhssEsghsgExsmiyhxsEww"+;

"mijhwwqyjhwiEyyhyyEyjhyjvFkxmwytjqdAvEsxmiqckvEg"+;

"xmbqccvEaqcEqcCmFktCwwljqhkmEstCigtAEckvaitCbgsk"+;

"EccmEagscqgamEDEcCEhkmawtDjgxkEgsmaigwsqiimabgwg"+;

"EgaEgDEiwmbjgywEiigyiEibgybgzjqFAvCsxliqEkvCgxlb"+;

"qEcvCaqEEvCDqECqEBEFAmCstBighAEEkmCgtBbggkqagvDb"+;

"ggcEEEmCDggEqaDgg"

CodageMC[1] = CodageMC[1] + ;

"CEasmDigisEagmDbgigqbbgiaEaDgiDgjigjbqCkvBgxkrqC"+;

"cvBaqCEvBDqCCqCBECkmBgtArgakECcmBagacqDamBDgaEEC"+;

"CgaCECBEDggbggbagbDvAqvAnqBBmAqEBEgDEgDCgDBlfAsp"+;

"sweyldksowClAlcssoiCkklcgCkcCkECvAlhssqyCtklgwsq"+;

"jCsslgiCsgCsaCxsliyCwwlijCwiCyyCyjtpkwuwyhjndAto"+;

"swuincktogwubncctoancEtoDlFksmwwdjnhklEssmiatACc"+;

"ktqismbaskngglEaascCcEasEChklawsnjaxkCgstrjawsni"+;

"ilabawgCgaawaCiwlbjaywCiiayiCibCjjazjvpAxusyxivo"+;

"kxugyxbvocxuavoExuDvoCnFAtmswtirhAnEkxviwtbrgkvq"+;

"gxvbrgcnEEtmDrgEvqDnEBCFAlCssliahACEklCgslbixAag"+;

"knagtnbiwkrigvrblCDiwcagEnaDiwECEBCaslDiaisCaglD"+;

"biysaignbbiygrjbCaDaiDCbiajiCbbiziajbvmkxtgywrvm"+;

"cxtavmExtDvmCvmBnCktlgwsrraknCcxtrracvnatlDraEnC"+;

"CraCnCBraBCCklBgskraakCCclBaiikaacnDalBDiicrbaCC"+;

"CiiEaaCCCBaaBCDglBrabgCDaijgabaCDDijaabDCDrijrvl"+;

"cxsqvlExsnvlCvlBnBctkqrDcnBEtknrDEvlnrDCnBBrDBCB"+;

"clAqaDcCBElAnibcaDEnBnibErDnCBBibCaDBibBaDqibqib"+;

"nxsfvkltkfnAmnAlCAoaBoiDoCAlaBlkpkBdAkosBckkogse"+;

"bBcckoaBcEkoDBhkkqwsfjBgskqiBggkqbBgaBgDBiwkrjBi"+;

"iBibBjjlpAsuswhil"

CodageMC[1] = CodageMC[1] + ;

"oksuglocsualoEsuDloCBFAkmssdiDhABEksvisdbDgklqgs"+;

"vbDgcBEEkmDDgElqDBEBBaskniDisBagknbDiglrbDiaBaDB"+;

"biDjiBbbDjbtukwxgyirtucwxatuEwxDtuCtuBlmkstgnqkl"+;

"mcstanqctvastDnqElmCnqClmBnqBBCkklgDakBCcstrbikD"+;

"aclnaklDbicnraBCCbiEDaCBCBDaBBDgklrDbgBDabjgDbaB"+;

"DDbjaDbDBDrDbrbjrxxcyyqxxEyynxxCxxBttcwwqvvcxxqw"+;

"wnvvExxnvvCttBvvBllcssqnncllEssnrrcnnEttnrrEvvnl"+;

"lBrrCnnBrrBBBckkqDDcBBEkknbbcDDEllnjjcbbEnnnBBBj"+;

"jErrnDDBjjCBBqDDqBBnbbqDDnjjqbbnjjnxwoyyfxwmxwlt"+;

"sowwfvtoxwvvtmtslvtllkossfnlolkmrnonlmlklrnmnllr"+;

"nlBAokkfDBolkvbDoDBmBAljbobDmDBljbmbDljblDBvjbvx"+;

"wdvsuvstnkurlurltDAubBujDujDtApAAokkegAocAoEAoCA"+;

"qsAqgAqaAqDAriArbkukkucshakuEshDkuCkuBAmkkdgBqkk"+;

"vgkdaBqckvaBqEkvDBqCAmBBqBAngkdrBrgkvrBraAnDBrDA"+;

"nrBrrsxcsxEsxCsxBktclvcsxqsgnlvEsxnlvCktBlvBAlcB"+;

"ncAlEkcnDrcBnEAlCDrEBnCAlBDrCBnBAlqBnqAlnDrqBnnD"+;

"rnwyowymwylswotxowyvtxmswltxlksosgfltoswvnvoltmk"+;

"slnvmltlnvlAkokcfBloksvDnoBlmAklbroDnmBllbrmDnlA"+;

"kvBlvDnvbrvyzeyzdwyexyuwydxytswetwuswdvxutwtvxtk"+;

"selsuksdntulstrvu"

CodageMC[2] = ;

"ypkzewxdAyoszeixckyogzebxccyoaxcEyoDxcCxhkyqwzfj"+;

"utAxgsyqiuskxggyqbuscxgausExgDusCuxkxiwyrjptAuws"+;

"xiipskuwgxibpscuwapsEuwDpsCpxkuywxjjftApwsuyifsk"+;

"pwguybfscpwafsEpwDfxkpywuzjfwspyifwgpybfwafywpzj"+;

"fyifybxFAymszdixEkymgzdbxEcymaxEEymDxECxEBuhAxas"+;

"yniugkxagynbugcxaaugExaDugCugBoxAuisxbiowkuigxbb"+;

"owcuiaowEuiDowCowBdxAoysujidwkoygujbdwcoyadwEoyD"+;

"dwCdysozidygozbdyadyDdzidzbxCkylgzcrxCcylaxCEylD"+;

"xCCxCBuakxDgylruacxDauaExDDuaCuaBoikubgxDroicuba"+;

"oiEubDoiCoiBcykojgubrcycojacyEojDcyCcyBczgojrcza"+;

"czDczrxBcykqxBEyknxBCxBBuDcxBquDExBnuDCuDBobcuDq"+;

"obEuDnobCobBcjcobqcjEobncjCcjBcjqcjnxAoykfxAmxAl"+;

"uBoxAvuBmuBloDouBvoDmoDlcbooDvcbmcblxAexAduAuuAt"+;

"oBuoBtwpAyeszFiwokyegzFbwocyeawoEyeDwoCwoBthAwqs"+;

"yfitgkwqgyfbtgcwqatgEwqDtgCtgBmxAtiswrimwktigwrb"+;

"mwctiamwEtiDmwCmwBFxAmystjiFwkmygtjbFwcmyaFwEmyD"+;

"FwCFysmziFygmzbFyaFyDFziFzbyukzhghjsyuczhahbwyuE"+;

"zhDhDyyuCyuBwmkydgzErxqkwmczhrxqcyvaydDxqEwmCxqC"+;

"wmBxqBtakwngydrviktacwnavicxrawnDviEtaCviCtaBviB"+;

"miktbgwnrqykmictb"

CodageMC[2] = CodageMC[2] + ;

"aqycvjatbDqyEmiCqyCmiBqyBEykmjgtbrhykEycmjahycqz"+;

"amjDhyEEyChyCEyBEzgmjrhzgEzahzaEzDhzDEzrytczgqgr"+;

"wytEzgngnyytCglzytBwlcycqxncwlEycnxnEytnxnCwlBxn"+;

"BtDcwlqvbctDEwlnvbExnnvbCtDBvbBmbctDqqjcmbEtDnqj"+;

"EvbnqjCmbBqjBEjcmbqgzcEjEmbngzEqjngzCEjBgzBEjqgz"+;

"qEjngznysozgfgfyysmgdzyslwkoycfxloysvxlmwklxlltB"+;

"owkvvDotBmvDmtBlvDlmDotBvqbovDvqbmmDlqblEbomDvgj"+;

"oEbmgjmEblgjlEbvgjvysegFzysdwkexkuwkdxkttAuvButA"+;

"tvBtmBuqDumBtqDtEDugbuEDtgbtysFwkFxkhtAhvAxmAxqB"+;

"xwekyFgzCrwecyFaweEyFDweCweBsqkwfgyFrsqcwfasqEwf"+;

"DsqCsqBliksrgwfrlicsraliEsrDliCliBCykljgsrrCyclj"+;

"aCyEljDCyCCyBCzgljrCzaCzDCzryhczaqarwyhEzananyyh"+;

"CalzyhBwdcyEqwvcwdEyEnwvEyhnwvCwdBwvBsncwdqtrcsn"+;

"EwdntrEwvntrCsnBtrBlbcsnqnjclbEsnnnjEtrnnjClbBnj"+;

"BCjclbqazcCjElbnazEnjnazCCjBazBCjqazqCjnaznzioir"+;

"srfyziminwrdzzililyikzygozafafyyxozivivyadzyxmyg"+;

"litzyxlwcoyEfwtowcmxvoyxvwclxvmwtlxvlslowcvtnosl"+;

"mvrotnmsllvrmtnlvrllDoslvnbolDmrjonbmlDlrjmnblrj"+;

"lCbolDvajoCbmizoajmCblizmajlizlCbvajvzieifwrFzzi"+;

"didyiczygeaFzywuy"

CodageMC[2] = CodageMC[2] + ;

"gdihzywtwcewsuwcdxtuwstxttskutlusktvnutltvntlBun"+;

"DulBtrbunDtrbtCDuabuCDtijuabtijtziFiFyiEzygFywhw"+;

"cFwshxsxskhtkxvlxlAxnBxrDxCBxaDxibxiCzwFcyCqwFEy"+;

"CnwFCwFBsfcwFqsfEwFnsfCsfBkrcsfqkrEsfnkrCkrBBjck"+;

"rqBjEkrnBjCBjBBjqBjnyaozDfDfyyamDdzyalwEoyCfwhow"+;

"EmwhmwElwhlsdowEvsvosdmsvmsdlsvlknosdvlroknmlrmk"+;

"nllrlBboknvDjoBbmDjmBblDjlBbvDjvzbebfwnpzzbdbdyb"+;

"czyaeDFzyiuyadbhzyitwEewguwEdwxuwgtwxtscustusctt"+;

"vustttvtklulnukltnrulntnrtBDuDbuBDtbjuDbtbjtjfsr"+;

"pyjdwrozjcyjcjzbFbFyzjhjhybEzjgzyaFyihyyxwEFwghw"+;

"wxxxxschssxttxvvxkkxllxnnxrrxBBxDDxbbxjFwrmzjEyj"+;

"EjbCzjazjCyjCjjBjwCowCmwClsFowCvsFmsFlkfosFvkfmk"+;

"flArokfvArmArlArvyDeBpzyDdwCewauwCdwatsEushusEts"+;

"htkdukvukdtkvtAnuBruAntBrtzDpDpyDozyDFybhwCFwahw"+;

"ixsEhsgxsxxkcxktxlvxAlxBnxDrxbpwnuzboybojDmzbqzj"+;

"psruyjowrujjoijobbmyjqybmjjqjjmwrtjjmijmbbljjnjj"+;

"lijlbjkrsCusCtkFukFtAfuAftwDhsChsaxkExkhxAdxAvxB"+;

"uzDuyDujbuwnxjbuibubDtjbvjjusrxijugrxbjuajuDbtij"+;

"vibtbjvbjtgrwrjtajtDbsrjtrjsqjsnBxjDxiDxbbxgnyrb"+;

"xabxDDwrbxrbwqbwn"

CodageMC[3] = ;

"pjkurwejApbsunyebkpDwulzeDspByeBwzfcfjkprwzfEfbs"+;

"pnyzfCfDwplzzfBfByyrczfqfrwyrEzfnfnyyrCflzyrBxjc"+;

"yrqxjEyrnxjCxjBuzcxjquzExjnuzCuzBpzcuzqpzEuznpzC"+;

"djAorsufydbkonwudzdDsolydBwokzdAyzdodrsovyzdmdnw"+;

"otzzdldlydkzynozdvdvyynmdtzynlxboynvxbmxblujoxbv"+;

"ujmujlozoujvozmozlcrkofwuFzcnsodyclwoczckyckjzcu"+;

"cvwohzzctctycszylucxzyltxDuxDtubuubtojuojtcfsoFy"+;

"cdwoEzccyccjzchchycgzykxxBxuDxcFwoCzcEycEjcazcCy"+;

"cCjFjAmrstfyFbkmnwtdzFDsmlyFBwmkzFAyzFoFrsmvyzFm"+;

"FnwmtzzFlFlyFkzyfozFvFvyyfmFtzyflwroyfvwrmwrltjo"+;

"wrvtjmtjlmzotjvmzmmzlqrkvfwxpzhbAqnsvdyhDkqlwvcz"+;

"hBsqkyhAwqkjhAiErkmfwtFzhrkEnsmdyhnsqtymczhlwEky"+;

"hkyEkjhkjzEuEvwmhzzhuzEthvwEtyzhthtyEszhszyduExz"+;

"yvuydthxzyvtwnuxruwntxrttbuvjutbtvjtmjumjtgrAqfs"+;

"vFygnkqdwvEzglsqcygkwqcjgkigkbEfsmFygvsEdwmEzgtw"+;

"qgzgsyEcjgsjzEhEhyzgxgxyEgzgwzycxytxwlxxnxtDxvbx"+;

"mbxgfkqFwvCzgdsqEygcwqEjgcigcbEFwmCzghwEEyggyEEj"+;

"ggjEazgizgFsqCygEwqCjgEigEbECygayECjgajgCwqBjgCi"+;

"gCbEBjgDjgBigBbCrklfwspzCnsldyClwlczCkyCkjzCuCvw"+;

"lhzzCtCtyCszyFuCx"

CodageMC[3] = CodageMC[3] + ;

"zyFtwfuwftsrusrtljuljtarAnfstpyankndwtozalsncyak"+;

"wncjakiakbCfslFyavsCdwlEzatwngzasyCcjasjzChChyza"+;

"xaxyCgzawzyExyhxwdxwvxsnxtrxlbxrfkvpwxuzinArdsvo"+;

"yilkrcwvojiksrciikgrcbikaafknFwtmzivkadsnEyitsrg"+;

"ynEjiswaciisiacbisbCFwlCzahwCEyixwagyCEjiwyagjiw"+;

"jCazaiziyzifArFsvmyidkrEwvmjicsrEiicgrEbicaicDaF"+;

"snCyihsaEwnCjigwrajigiaEbigbCCyaayCCjiiyaajiijiF"+;

"krCwvljiEsrCiiEgrCbiEaiEDaCwnBjiawaCiiaiaCbiabCB"+;

"jaDjibjiCsrBiiCgrBbiCaiCDaBiiDiaBbiDbiBgrAriBaiB"+;

"DaAriBriAqiAnBfskpyBdwkozBcyBcjBhyBgzyCxwFxsfxkr"+;

"xDfklpwsuzDdsloyDcwlojDciDcbBFwkmzDhwBEyDgyBEjDg"+;

"jBazDizbfAnpstuybdknowtujbcsnoibcgnobbcabcDDFslm"+;

"ybhsDEwlmjbgwDEibgiDEbbgbBCyDayBCjbiyDajbijrpkvu"+;

"wxxjjdArosvuijckrogvubjccroajcEroDjcCbFknmwttjjh"+;

"kbEsnmijgsrqinmbjggbEajgabEDjgDDCwlljbawDCijiwba"+;

"iDCbjiibabjibBBjDDjbbjjjjjFArmsvtijEkrmgvtbjEcrm"+;

"ajEErmDjECjEBbCsnlijasbCgnlbjagrnbjaabCDjaDDBibD"+;

"iDBbjbibDbjbbjCkrlgvsrjCcrlajCErlDjCCjCBbBgnkrjD"+;

"gbBajDabBDjDDDArbBrjDrjBcrkqjBErknjBCjBBbAqjBqbA"+;

"njBnjAorkfjAmjAlb"

CodageMC[3] = CodageMC[3] + ;

"AfjAvApwkezAoyAojAqzBpskuyBowkujBoiBobAmyBqyAmjB"+;

"qjDpkluwsxjDosluiDoglubDoaDoDBmwktjDqwBmiDqiBmbD"+;

"qbAljBnjDrjbpAnustxiboknugtxbbocnuaboEnuDboCboBD"+;

"msltibqsDmgltbbqgnvbbqaDmDbqDBliDniBlbbriDnbbrbr"+;

"ukvxgxyrrucvxaruEvxDruCruBbmkntgtwrjqkbmcntajqcr"+;

"vantDjqEbmCjqCbmBjqBDlglsrbngDlajrgbnaDlDjrabnDj"+;

"rDBkrDlrbnrjrrrtcvwqrtEvwnrtCrtBblcnsqjncblEnsnj"+;

"nErtnjnCblBjnBDkqblqDknjnqblnjnnrsovwfrsmrslbkon"+;

"sfjlobkmjlmbkljllDkfbkvjlvrsersdbkejkubkdjktAeyA"+;

"ejAuwkhjAuiAubAdjAvjBuskxiBugkxbBuaBuDAtiBviAtbB"+;

"vbDuklxgsyrDuclxaDuElxDDuCDuBBtgkwrDvglxrDvaBtDD"+;

"vDAsrBtrDvrnxctyqnxEtynnxCnxBDtclwqbvcnxqlwnbvED"+;

"tCbvCDtBbvBBsqDtqBsnbvqDtnbvnvyoxzfvymvylnwotyfr"+;

"xonwmrxmnwlrxlDsolwfbtoDsmjvobtmDsljvmbtljvlBsfD"+;

"svbtvjvvvyevydnwerwunwdrwtDsebsuDsdjtubstjttvyFn"+;

"wFrwhDsFbshjsxAhiAhbAxgkirAxaAxDAgrAxrBxckyqBxEk"+;

"ynBxCBxBAwqBxqAwnBxnlyoszflymlylBwokyfDxolyvDxmB"+;

"wlDxlAwfBwvDxvtzetzdlyenyulydnytBweDwuBwdbxuDwtb"+;

"xttzFlyFnyhBwFDwhbwxAiqAinAyokjfAymAylAifAyvkzek"+;

"zdAyeByuAydBytszp"

CodeErr = 0

If Alltrim(Chaine) == "" Then

CodeErr = 1

Return .F.

Endif

*!*Split the string in character blocks of the same type : numeric , text, byte

*!*The first column of the array Liste% contain the char. number, the second one contain the mode switch

IndexChaine = 1

*Do QuelMode && modifica "Mode"

=QuelMode(@Chaine, @IndexChaine, @CodeASCII, @Mode)

 

Do While IndexChaine <= Len(Chaine)

IndexListe = IndexListe + 1

Dimension Liste[IndexListe,2]

Liste[IndexListe,2] = Mode

Do While Liste[IndexListe,2] = Mode

Liste[IndexListe,1] = Iif(Vartype(Liste[IndexListe,1])="N", Liste[IndexListe,1], 0) + 1

IndexChaine = IndexChaine + 1

If IndexChaine > Len(Chaine) Then

Exit

Endif

*Do QuelMode

=QuelMode(@Chaine, @IndexChaine, @CodeASCII, @Mode)

Enddo

*IndexListe = IndexListe + 1

Enddo

* Set Step On

*!*We retain "numeric" mode only if it&&s earning, else "text" mode or even "byte" mode

*!*The efficiency limits have been pre-defined according to the previous mode and/or the next mode.

For i = 1 To IndexListe

If Liste[I,2] = 902 Then

If i = 1 Then

*-- It's the first block

If IndexListe > 1 Then && And there is other blocks behind

If Liste[I+1, 2] = 900 Then && First block and followed by a "text" type block

If Liste[I,1] < 8 Then

Liste[I,2] = 900

Endif

Else

If Liste[I+1, 2] = 901 Then && First block and followed by a "byte" type block

If Liste[I,1] = 1 Then

Liste[I,2] = 901

Endif

Endif

Endif

Endif

Else

*-- It's not the first block

If i = IndexListe Then

*-- It's the last one

If Liste[I-1, 2] = 900 Then

*-- It's preceded by a "text" type block

If Liste[I,1] < 7 Then

Liste[I,2] = 900

Endif

Else

*-- It's preceded by a "byte" type block

If Liste[I-1, 2] = 901 Then

If Liste[I,1] = 1 Then

Liste[I,2] = 901

Endif

Endif

Endif

Else

*-- It's not the last block

If Liste[I-1, 2] = 901 And Liste[I+1, 2] = 901 Then

*-- Framed by "byte" type blocks

If Liste[I,1] < 4 Then

Liste[I,2] = 901

Endif

Else

If Liste[I-1, 2] = 900 And Liste[I+1, 2] = 901 Then

*-- Preceded by "text" and followed by "byte" (If the reverse it's never interesting to change)

If Liste[I,1] < 5 Then

Liste[I,2] = 900

Endif

Else

If Liste[I-1, 2] = 900 And Liste[I+1, 2] = 900 Then

*-- Framed by "text" type blocks

If Liste[I,1] < 8 Then

Liste[I,2] = 900

Endif

Endif

Endif

Endif

Endif

Endif

Endif

Endfor

*Do Regroupe

=Regroupe(@Liste, @IndexListe)

*-- Maintain "text" mode only if it's earning

For i = 1 To IndexListe

If Liste[I,2] = 900 And i > 1 Then

*-- It's not the first (If first, never interesting to change)

If i = IndexListe Then && It's the last one

If Liste[I-1, 2] = 901 Then

*-- It's preceded by a "byte" type block

If Liste[I,1] = 1 Then

Liste[I,2] = 901

Endif

Endif

Else

*-- It's not the last one

If Liste[I-1, 2] = 901 And Liste[I+1, 2] = 901 Then

*-- Framed by "byte" type blocks

If Liste[I,1] < 5 Then

Liste[I,2] = 901

Endif

Else

If (Liste[I-1, 2] = 901 And Liste[I+1, 2] <> 901) Or (Liste[I-1, 2] <> 901 And Liste[I+1, 2] = 901) Then

*-- A "byte" block ahead or behind

If Liste[I,1] < 3 Then

Liste[I,2] = 901

Endif

Endif

Endif

Endif

Endif

Endfor

*Do Regroupe

=Regroupe(@Liste, @IndexListe)

*-- Now we compress datas into the MCs, the MCs are stored in 3 char. in a large string : ChaineMC$

IndexChaine = 1

For i = 1 To IndexListe

*-- Thus 3 compaction modes

Do Case

Case Liste[I,2] = 900 && Texte

Dimension ListeT[Liste[1, I], 2]

*-- ListeT% will contain the table number(s) (1 ou several) and the value of each char.

*-- Table number encoded in the 4 less weight bits, that is in decimal 1, 2, 4, 8

For IndexListeT = 1 To Liste[I,1]

CodeASCII = Asc( Substr(Chaine, IndexChaine + IndexListeT, 1) )

Do Case

Case CodeASCII = 9 && HT

ListeT[IndexListeT, 1] = 12

ListeT[IndexListeT, 2] = 12

Case CodeASCII = 10 && LF

ListeT[IndexListeT, 1] = 8

ListeT[IndexListeT, 2] = 15

Case CodeASCII = 13 && CR

ListeT[IndexListeT, 1] = 12

ListeT[IndexListeT, 2] = 11

Otherwise

ListeT[IndexListeT, 1] = Val( Substr(xAscii, CodeASCII * 4 - 127, 2) )

ListeT[IndexListeT, 2] = Val( Substr(xAscii, CodeASCII * 4 - 125, 2) )

Endcase

Endfor

CurTable = 1 && Default table

ChaineT = ""

*-- Datas are stored in 2 char. in the string TableT$

For j = 1 To Liste[I,1]

If Bitand(ListeT[J,1], CurTable) > 0 Then

*-- The char. is in the current table

ChaineT = ChaineT + Padl(Transform(ListeT[J,2]),2,"0") && Format(ListeT[1, J], "00")

Else

*-- Obliged to change the table

xFlag = .F. && True if we change the table only for 1 char.

If j = Liste[I,1] Then

xFlag = .T.

Else

If Bitand(ListeT[J,1], ListeT[J+1, 1]) = 0 Then

xFlag = .T. && No common table with the next char.

Endif

Endif

If xFlag Then

*-- We change only for 1 char., Look for a temporary switch

If Bitand(ListeT[J,1], 1) > 0 And CurTable = 2 Then

*-- Table 2 to 1 for 1 char. --> T_UPP

ChaineT = ChaineT + "27" + Padl(Transform(ListeT[J,2]),2,"0") && Format(ListeT[1, J], "00")

Else

If Bitand(ListeT[J,1], 8) > 0 Then

*-- Table 1 or 2 or 4 to table 8 for 1 char. --> T_PUN

ChaineT = ChaineT + "29" + Padl(Transform(ListeT[J,2]),2,"0") && Format(ListeT%(1, J%), "00")

Else

*-- No temporary switch available

xFlag = .F.

Endif

Endif

Endif

*-- We test again flag which is perhaps changed ! Impossible to use ELSE statement

If Not xFlag Then

*-- We must use a bi-state switch

*-- Looking for the new table to use

If j = Liste[I,1] Then

NewTable = ListeT[J,1]

Else

NewTable = Iif( Bitand(ListeT[J,1], ListeT[J+1,1]) = 0, ListeT[J,1], Bitand(ListeT[J,1], ListeT[J+1,1]) )

Endif

*-- Maintain the first if several tables are possible

Do Case

Case Inlist(NewTable, 3, 5, 7, 9, 11, 13, 15)

NewTable = 1

Case Inlist(NewTable, 6, 10, 14)

NewTable = 2

Case NewTable = 12

NewTable = 4

Endcase

*-- Select the switch, on occasion we must use 2 switchs consecutively

Do Case

Case CurTable = 1

Do Case

Case NewTable = 2

ChaineT = ChaineT + "27"

Case NewTable = 4

ChaineT = ChaineT + "28"

Case NewTable = 8

ChaineT = ChaineT + "2825"

Endcase

Case CurTable = 2

Do Case

Case NewTable = 1

ChaineT = ChaineT + "2828"

Case NewTable = 4

ChaineT = ChaineT + "28"

Case NewTable = 8

ChaineT = ChaineT + "2825"

Endcase

Case CurTable = 4

Do Case

Case NewTable = 1

ChaineT = ChaineT + "28"

Case NewTable = 2

ChaineT = ChaineT + "27"

Case NewTable = 8

ChaineT = ChaineT + "25"

Endcase

Case CurTable = 8

Do Case

Case NewTable = 1

ChaineT = ChaineT + "29"

Case NewTable = 2

ChaineT = ChaineT + "2927"

Case NewTable = 4

ChaineT = ChaineT + "2928"

Endcase

Endcase

CurTable = NewTable

*-- At last we add the char.

ChaineT = ChaineT + Padl(Transform(ListeT[J,2]),2,"0") &&Format(ListeT%(1, J%), "00")

Endif

Endif

Endfor

If Mod( Len(ChaineT), 4) > 0 Then

ChaineT = ChaineT + "29" && Padding if number of char. is odd

Endif

*-- Now translate the string ChaineT$ into CWs

If i > 0 Then

ChaineMC = ChaineMC + "900" && Set up the switch exept for the first block because "text" is the default

Endif

For j = 1 To Len(ChaineT) Step 4

lnAux = Val(Substr(ChaineT, j, 2)) * 30 + Val(Substr(ChaineT, j+2, 2))

ChaineMC = ChaineMC + Padl(Transform( lnAux ),3,"0") && Format(Mid$(ChaineT$, J%, 2) * 30 + Mid$(ChaineT$, J% + 2, 2), "000")

Endfor

Case Liste[I,2] = 901 && Octet

*-- Select the switch between the 3 possible

If Liste(1, i) = 1 Then

*-- 1 seul octet, c'est immédiat

lnAux = Asc( Substr(Chaine, IndexChaine, 1) )

ChaineMC = ChaineMC + "913" + Padl(Transform( lnAux ),3,"0") && Format(Asc(Mid$(Chaine$, IndexChaine%, 1)), "000")

Else

*-- Select the switch for perfect multiple of 6 bytes or no

If Mod(Liste[I,1], 6) = 0 Then

ChaineMC = ChaineMC + "924"

Else

ChaineMC = ChaineMC + "901"

Endif

j = 0

Do While j < Liste[I,1]

Longueur = Liste[I,1] - j

If Longueur >= 6 Then

*-- Take groups of 6

Longueur = 6

xTotal = 0

For k = 0 To Longueur - 1

xTotal = xTotal + ( Asc(Substr(Chaine, IndexChaine + j + k, 1)) * 256 ^ (Longueur - 1 - k))

Endfor

ChaineMod = Transform(xTotal) && Format(Total, "general number")

Dummy = ""

Do While .T. && eraun loop contniuu care se rupe din cod: Do / Loop

Diviseur = 900

*Do Modulo

=Modulo(@ChaineMult, @ChaineMod, @Diviseur)

*-&& Dummy$ = Format(Diviseur&, "000") & Dummy$

Dummy = Padl(Transform( Diviseur ),3,"0") + Dummy

ChaineMod = ChaineMult

If ChaineMult = "" Then

Exit

Endif

Enddo

ChaineMC = ChaineMC + Dummy

Else

*-- If it remain a group of less than 6 bytes

For k = 0 To Longueur - 1

lnAux = Asc(Substr(Chaine, IndexChaine + j + k, 1))

ChaineMC = ChaineMC + Padl(Transform( lnAux ),3,"0") && Format(Asc(Mid$(Chaine$, IndexChaine% + J% + K%, 1)), "000")

Endfor

Endif

j = j + Longueur

Enddo

Endif

Case Liste[I,2] = 902 && Numeric

ChaineMC = ChaineMC + "902"

j = 0

Do While j < Liste[I,1]

Longueur = Liste[I,1] - j

If Longueur > 44 Then

Longueur = 44

Endif

ChaineMod = "1" + Substr(Chaine, IndexChaine + j, Longueur)

Dummy = ""

Do While .T. && Loop continuu

Diviseur = 900

*Do Modulo

=Modulo(@ChaineMult, @ChaineMod, @Diviseur)

Dummy = Padl(Transform( Diviseur ),3,"0") + Dummy && Format(Diviseur&, "000") & Dummy$

ChaineMod = ChaineMult

If ChaineMult = "" Then

Exit

Endif

Enddo

ChaineMC = ChaineMC + Dummy

j = j + Longueur

Enddo

? "ChaineMC: ", ChaineMC

Endcase

IndexChaine = IndexChaine + Liste[I,1]

Endfor

*-- ChaineMC$ contain the MC list (on 3 digits) depicting the datas

*-- Now we take care of the correction level

Longueur = Len(ChaineMC) / 3

If Secu < 0 Then

*-- Fixing auto. the correction level according to the standard recommendations

Do Case

Case Longueur < 41

Secu = 2

Case Longueur < 161

Secu = 3

Case Longueur < 321

Secu = 4

Otherwise

Secu = 5

Endcase

Endif

*-- Now we take care of the number of CW per row

Longueur = Longueur + 1 + (2 ^ (Secu + 1))

If nBcol > 30 Then

nBcol = 30

Endif

If nBcol < 1 Then

*-- With a 3 modules high font, for getting a "square" bar code

*-- x = nb. of col. | Width by module = 69 + 17x | Height by module = 3t / x (t is the total number of MCs)

*-- Thus we have 69 + 17x = 3t/x <=> 17x²+69x-3t=0 - Discriminant is 69²-4*17*-3t = 4761+204t thus x=SQR(discr.)-69/2*17

nBcol = (Sqrt(204 * Longueur + 4761) - 69) / (34 / 1.3) && 1.3 = balancing factor determined at a guess after tests

If nBcol = 0 Then

nBcol = 1

Endif

Endif

*-- If we go beyong 928 CWs we try to reduce the correction level

Do While Secu > 0

*-- Calculation of the total number of CW with the padding

Longueur = Len(ChaineMC) / 3 + 1 + (2 ^ (Secu + 1))

Longueur = ( Int(Longueur / nBcol) + Iif( Mod(Longueur, nBcol) > 0, 1, 0)) * nBcol

If Longueur < 929 Then

Exit

Endif

*-- We must reduce security level

Secu = Secu - 1

CodeErr = 10

Enddo

If Longueur > 928 Then

CodeErr = 2

Return && intorc eroare sau intorc .f.

Endif

If Longueur / nBcol > 90 Then

CodeErr = 3

Return

Endif

*-- Padding calculation

Longueur = Len(ChaineMC) / 3 + 1 + (2 ^ (Secu + 1))

i = 0

If Int(Longueur / nBcol) < 3 Then

i = nBcol * 3 - Longueur && A bar code must have at least 3 row

Else

If Mod(Longueur, nBcol) > 0 Then

i = nBcol - Mod(Longueur, nBcol)

Endif

Endif

*-- We add the padding

Do While i > 0

ChaineMC = ChaineMC + "900"

i = i - 1

Enddo

*-- We add the length descriptor

lnAux = Len(ChaineMC) / 3 + 1

ChaineMC = Padl(Transform( lnAux ),3,"0") + ChaineMC

*-- Now we take care of the Reed Solomon codes

Longueur = Len(ChaineMC) / 3

k = 2 ^ (Secu + 1)

Dimension MCcorrection[K]

xTotal = 0

For i = 0 To Longueur - 1

xTotal = Mod( Val(Substr(ChaineMC, i * 3 + 1, 3)) + Iif(Vartype(MCcorrection[K])="N",MCcorrection[K],0), 929 )

For j = k To 1 Step -1

If j = 1 Then

lnAux = Mod(xTotal * Val(Substr(CoefRS[secu], j-1 * 3 + 1, 3)), 929) &&!- j-1

MCcorrection[J] = Mod(929 - lnAux, 929)

Else

lnAux = Mod(xTotal * Val(Substr(CoefRS[secu], j-1 * 3 + 1, 3)), 929) &&!- j-1

MCcorrection[J] = Mod( Iif(Vartype(MCcorrection[J-1])="N",MCcorrection[J-1],0) + 929 - lnAux, 929)

Endif

Endfor

Endfor

For j = 1 To k

If MCcorrection[J] <> 0 Then

MCcorrection[J] = 929 - MCcorrection[J]

Endif

Endfor

*-- We add theses codes to the string

For i = k To 1 Step -1

ChaineMC = ChaineMC + Padl(Transform( MCcorrection[I] ),3,"0") && Format(MCcorrection%(I%), "000")

Endfor

*-- The CW string is finished

*-- Calculation of parameters for the left and right side CWs

C1 = Int( (Len(ChaineMC) / 3 / nBcol - 1) / 3)

C2 = Secu * 3 + Mod( (Len(ChaineMC) / 3 / nBcol - 1), 3)

C3 = nBcol - 1

*-- We encode each row

For i = 1 To (Len(ChaineMC) / 3 / nBcol)

Dummy = Substr(ChaineMC, i-1 * nBcol * 3 + 1, nBcol * 3) &&!- i-1

k = Int(i / 3) * 30 && i-1

Do Case

Case Mod(i, 3) = 0 && i-1

Dummy = Padl(Transform( k + C1 ),3,"0") + Dummy + Padl(Transform( k + C3 ),3,"0")

Case Mod(i, 3) = 1 && i-1

Dummy = Padl(Transform( k + C2 ),3,"0") + Dummy + Padl(Transform( k + C1 ),3,"0")

Case Mod(i, 3) = 2 && i-1

Dummy = Padl(Transform( k + C3 ),3,"0") + Dummy + Padl(Transform( k + C2 ),3,"0")

Endcase

pdf417 = pdf417 + "+*" && Start with a start char. and a separator

For j = 1 To Len(Dummy) / 3

lnAux = Val(Substr(Dummy, j-1 * 3 + 1, 3)) * 3 + 1 &&!- j-1

pdf417 = pdf417 + Substr( CodageMC[MOD(I,3)+1], lnAux, 3) + "*"

Endfor

pdf417 = pdf417 + "-" + Chr(13) + Chr(10) && Add a stop char. and a CRLF

Endfor

Return pdf417

Endfunc

 

Procedure Regroupe(Liste, IndexListe)

*-- Bring together same type blocks

If IndexListe > 1 Then

i = 1

Do While i < IndexListe && <=

If Liste[I,2] = Liste[I+1, 2] Then

*-- Bringing together

Liste[I,1] = Liste[I,1] + Liste[I+1, 1]

j = i + 1

*-- Decrease the list

Do While j < IndexListe && <=

Liste[J,1] = Liste[J+1, 1]

Liste[J,2] = Liste[J+1, 2]

j = j + 1

Enddo

IndexListe = IndexListe - 1

i = i - 1

Endif

i = i + 1

Enddo

Endif

Endproc

 

Procedure QuelMode(Chaine, IndexChaine, CodeASCII, Mode)

CodeASCII = Asc( Substr(Chaine, IndexChaine, 1) )

Do Case

Case Between(CodeASCII, 48, 57)

Mode = 902

Case Between(CodeASCII, 32, 126) Or Inlist(CodeASCII, 9, 10, 13, 32)

Mode = 900

Otherwise

Mode = 901

Endcase

Endproc

 

Procedure Modulo(ChaineMult, ChaineMod, Diviseur)

*!*ChaineMod$ depict a very large number having more than 9 digits

*!*Diviseur& is the divisor, contain the result after return

*!*ChaineMult$ contain after return the result of the integer division

ChaineMult = ""

Nombre = 0

Do While ChaineMod <> ""

Nombre = Nombre * 10 + Val(Left(ChaineMod,1)) && put dow a digit

ChaineMod = Right(ChaineMod,Len(ChaineMod)-1)

If Nombre < Diviseur Then

If ChaineMult <> "" Then

ChaineMult = ChaineMult + "0"

Endif

Else

ChaineMult = ChaineMult + Transform( Int(Nombre / Diviseur) )

Endif

Nombre = Mod(Nombre,Diviseur)

Enddo

Diviseur = Nombre

Endproc

 

portare_pdf417_gen.txt 
 2/23/2009 7:20:50 AM
User is offlineCostel
332 posts
www.adrisoft.ro
3rd




Re: codul de bare pentru ordinele de plata
 (N/A)
 Costel wrote
Din ce-am gasit si eu pe internet, vezi in attachment


Mii de scuze dar din pacate eu nu am studiat problema. Exemplul atasat l-am gasit pe internet si l-am salvat in situatia ca daca ma voi lovi de o asemenea problema o sa am un punct de plecare. Din pacate nu stiu nici de pe ce forum l-am salvat si iarasi din pacate momentan problema nu intra in atentia mea si nici timpul nu-mi permite sa fac ceva incercari 



Nu munci atit de mult incit sa nu-ti mai ramina timp ca sa cistigi bani. (proverb evreiesc)
 2/23/2009 10:37:09 AM
User is offlinefpruna
31 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Functia nu gaseste fisierele
"table1.txt", "table2.txt","table3.txt"
dupa cum scrie in comentariul functiei.
 2/23/2009 1:09:28 PM
User is offlineedyshor
1450 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A)
Nici o problema Costel, mersi ca ai incercat, codul respectiv tot pe profox -i gasit, am dat si eu de el la .. hmm, puteam sajur ca-i aici.
 2/23/2009 2:58:42 PM
User is offlinefpruna
31 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
uite cele trei fisiere de care vorbeam
PDF417_tables.zip 
 2/23/2009 3:18:29 PM
User is offlineVictor Iuga
189 posts
5th


Re: codul de bare pentru ordinele de plata
 (Romania)

cum se descarca atasurile ?

pe mine ma tot trimite la un linkclik.asx

...

 2/23/2009 3:50:16 PM
User is offlinefpruna
31 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Nu merge Attachment da urmatoare eroare.

An Error Has Occurred When Attempting To Save The File D:\HostingSpaces\ms-profox\profox.ro\wwwroot\Portals\0\ForumAttachment\PDF417_tables.zip. Please Contact Your Hosting Provider To Ensure The Appropriate Security Settings Have Been Enabled On The Server.
 2/23/2009 4:04:30 PM
User is offlineGrigore Dolghin
4001 posts
www.class-software.ro
1st






Re: codul de bare pentru ordinele de plata
 (Romania)
Mdah, stiu de problema asta. Din pacate hostingul nu mai este valabil si in momentul acesta profox-ul mai este gazduit doar din bunavointa. Chestia e ca sunt extrem de prins de la o vreme si pur si simplu nu am mai avut timp sa ma ocup si de transferul datelor din formatul lui DNN in formatul lui PHPBB. Mi-ar trebui doua zile pentru asta, dar daca le-as avea as prefera sa dorm, ca deja ma clatin pe picioare. :(

Grigore Dolghin
Visual FoxPro MVP 2006 - 2010
Class Software
My blog
 2/23/2009 7:05:55 PM
User is offlineedyshor
1450 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A) Modified By edyshor  on 2/24/2009 12:29:25 AM)
 fpruna wrote
Nu merge Attachment da urmatoare eroare.

An Error Has Occurred When Attempting To Save The File D:\HostingSpaces\ms-profox\profox.ro\wwwroot\Portals\0\ForumAttachment\PDF417_tables.zip. Please Contact Your Hosting Provider To Ensure The Appropriate Security Settings Have Been Enabled On The Server.


Poti sa le ridici pe un site de sharing ( www.4shared.com de ex ) si sa postezi linku catre ele ..

 2/24/2009 10:38:17 AM
User is offlinefpruna
31 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Le-am ridicat pe www.4shared.com
[URL=http://www.4shared.com/file/89211994/6ed7712/PDF417_tables.html]PDF417_tables.zip[/URL]

 2/24/2009 10:44:54 AM
User is offlinefpruna
31 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Am puse aici arhiva PDF417_tables.zip
http://www.4shared.com/file/89211994/6ed7712/PDF417_tables.html

 2/27/2009 5:59:26 PM
User is offlinegabi123
535 posts
1st


Re: codul de bare pentru ordinele de plata
 (N/A)

Am facut , de fapt continuat munca altui coleg de pe forum d-l cazacu caruia ii multumesc bineinteles si pe aceasta cale , o clasa care genereaza codul asta de bare si  daca tot am sapat am facut si ean13 . daca-mi dai o adresa de mail iti trimit, nu de alta da nu pot uploada in forum nicicum.

S-auzim de bine

barele.rar 
 2/27/2009 6:00:46 PM
User is offlinegabi123
535 posts
1st


Re: codul de bare pentru ordinele de plata
 (N/A)
se pare ca s-a up ? minune
 2/27/2009 11:03:56 PM
User is offlineGhiorghiu Bogdan
929 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A)
Din pacate fisierul cu clasa din arhiva da eroare la citire.

Ghiorghiu Bogdan >>> Dacă tot te apuci să faci o treabă, fă-o bine de la inceput!
 2/28/2009 7:41:17 AM
User is offlinegabi123
535 posts
1st


Re: codul de bare pentru ordinele de plata
 (Romania)

m-am bucurat prea repede , dupa ce m-am delogat lucrurile au aratat altfel

pina la remediere , folositi asta : http://www.infap.ro/diverse/barele.zip

 3/1/2009 2:08:22 PM
User is offlineEugen Gliga
2229 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A)
Am testat putin clasa. Pt  Pdf417 mi-a mers, adica mi-a generat bmp-ul insa la Ean13 mi-a dat o eroare "Object is not contained in a form", probabil ca e  ceva banal, dar n-am apucat sa ma uit prin clasa.

 3/1/2009 9:45:33 PM
User is offlineedyshor
1450 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A)
Merge! (pdf417)
 3/2/2009 7:44:12 AM
User is offlinegabi123
535 posts
1st


Re: codul de bare pentru ordinele de plata
 (Romania)
am corectat ean13 ,  re-descarcati
 3/2/2009 10:25:46 AM
User is offlineEugen Gliga
2229 posts
1st




Re: codul de bare pentru ordinele de plata
 (N/A)
Da, acum merg amandoua. Multumim.


 3/10/2009 11:02:14 AM
User is offlineovydyu20
2 posts


Re: codul de bare pentru ordinele de plata
 (N/A) Modified By ovydyu20  on 3/10/2009 11:03:32 AM)
care ma ajuta si pe mine cu arhiva barele.rar ca la mine nu merge sau sa-mi spuna cum fac codul de bare in PDF417
 3/21/2009 10:53:41 AM
User is offlinePROFOX
47 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Poti sa-mi trimiti si mie clasa care genereaza codul de bare? Adresa mea de mail este laceadoina@hotmail.com. Multumesc mult !
 4/14/2009 8:47:34 PM
User is offlinenicu
303 posts
3rd


Re: codul de bare pentru ordinele de plata
 (N/A)

Se poate sa-mi trimiti si mie clasa care genereaza codul de bare?
http://www.infap.ro/diverse/barele.zip  nu merge accesat.
 Adresa mail : e.nicu@yahoo.com.  Multumesc.
 3/18/2010 10:31:38 AM
User is offlinejustgioni
102 posts
5th


Re: codul de bare pentru ordinele de plata
 (N/A)
I-mi puteti trimite si mie arhiva "barele" pe adresa ionut_invest@yahoo.com
Va multumsc!
 5/16/2011 10:09:27 PM
User is offlinecrisoftdesign
9 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
Unde pot gasi structura sirului de caractere (cu explicatii) care se foloseste pentru generarea codului de bare 2d (pdf417) in: - ordine de plata trezorerie - declaratii fiscale (100) - care este algoritmul de calcul al cifrelor de control din numarul de evidenta ? - decont TVA (300) Multumesc anticipat.
 5/16/2011 11:05:13 PM
User is offlineDoru Constantin
445 posts
2nd




Re: codul de bare pentru ordinele de plata
 (N/A) Modified By Doru Constantin  on 5/16/2011 10:07:58 PM)
1. instr100.txt Structuri.txt
2. suma cifrelor
 5/17/2011 8:51:47 PM
User is offlineadimorarasu
92 posts
morarasu-adrian.num.ro




Re: codul de bare pentru ordinele de plata
 (N/A) Modified By adimorarasu  on 5/17/2011 7:52:49 PM)
Va exemplific cum am eu:
In arhiva atasata sunt: un dll si un fisier font. Toate au la baza solutia de pe grandzebu.
Ideea este ca se formeaza un sir care se "codeaza" iar acest sir codat trebuie afisat folosind fontul.

Iata un exemplu de cod:

mcb = '#' + ALLTRIM(nrdoc) + '#,' + '' + ALLTRIM(IIF(INT(suma) = suma, STR(suma, 10), STR(suma, 13, 2))) + ',' + ;
'#' + ALLTRIM(nume_pl) +'#,' + '' + ALLTRIM(str(cif_pl,13)) + ',' + '#' + ALLTRIM(adr_pl) + '#,' + '#' + ;
ALLTRIM(iban_pl) + '#,' + '#' + ALLTRIM(bic_pl) + '#,' + '#' + ;
ALLTRIM(nume_ben) + '#,' + '' + ALLTRIM(str(cif_ben,13)) + ',' + '#' + ;
ALLTRIM(iban_ben) + '#,' + '#' + ALLTRIM(bic_ben) + '#,' + ',' + '#' + ;
ALLTRIM(oblig) + '#,' + '' + DTOC(datapl) + ''
coderr=0
x=createobject('pdf417.adipdf')
codpdf=x.encode417(mcb,-1,0,coderr)

iar in raportul pt listarea op-ului variabila codpdf este afisata folosind fontul din arhiva atasata. La mine functioneaza perfect.
Bafta.
send.rar 
 1/30/2014 11:32:52 AM
User is offlinecostin_mentor
748 posts
www.accessoft.ro
1st




Re: codul de bare pentru ordinele de plata
 (N/A)
Daca este cineva disponibil si are codul pentru generarea codului de bare din declaratiile fiscale, il rog sa-l posteze pe forum.
 9/21/2015 6:28:28 PM
User is offlinestefan_JKSL
90 posts


Re: codul de bare pentru ordinele de plata
 (N/A)
se poate sa puna cineva barele.rar actualizat? multumesc anticipat.
 9/21/2015 7:48:29 PM
User is offlinegabi123
535 posts
1st


Re: codul de bare pentru ordinele de plata
 (N/A)
pai e in discutia urmatoare
 9/21/2015 7:48:40 PM
User is offlinegabi123
535 posts
1st


Re: codul de bare pentru ordinele de plata
 (N/A) Modified By gabi123  on 9/21/2015 6:52:05 PM)
pai e in discutia urmatoare. Scuze de dublura se salveaza tare greu
  Visual FoxPro  Visual FoxPro in general  codul de bare p...

Search  Forum Home         

Copyright 2002-2013 Profox   Terms Of Use  Privacy Statement