Code 2of5 interleaved generator, calc, barcode, ITF14, GPL .

Gotowe szablony, skrypty, makropolecenia i rozszerzenia. Tutaj możesz pochwalić i podzielić się swoją twórczością z innymi użytkownikami
OOoUser46
Posty: 23
Rejestracja: sob maja 12, 2012 2:43 pm
Lokalizacja: Olesno Tarn.

Code 2of5 interleaved generator, calc, barcode, ITF14, GPL .

Post autor: OOoUser46 »

Witam.

Jest to generator kodu kreskowego Code2of5i.
Kod kreskowy 2 z 5 przeplatany dla arkusza kalkulacyjnego.
Aby kod wyświetlał się poprawnie potrzeba całkowicie darmową czcionkę barcode: http://user.services.openoffice.org/pl/ ... php?id=429

Skrypt testowałem u siebie i działa 100% (OOo3.2,win7) ewentualne błędy będę starał się poprawić.
Generowane kody odczytywane były bez problemu przez czytnik PSC QuickScan 1000.
Makro instalujemy metodą "kopiuj wklej" w menadżerze makr OpenOffice .
Działa polecenie CODE25I(1234567890;0) .
Pierwszy argument to zawartość kodu liczba lub cyfry, drugi opcjonalny to wymuszona długość kodu
pomocna przy np numerach seryjnych, dodaje zera wiodące lub przycina od lewej za długi ciąg.
Zero oznacza automatyczną długość .

Kod: Zaznacz cały

REM  *****  BASIC  *****
REM V1.5 14-11-2012
REM Barcode creator code25i by TN
REM Funkcja generuje kod przeplatany 2 z 5
REM 
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM 
REM code25i(znaki cyfr lub liczba; wymuszona stała długość, 0 = automatyczna długość, max=50)
REM 
REM ! UWAGA !
REM Do poprawnego działania wymagana jest odpowiednia czcionka barcode.ttf
REM http://user.services.openoffice.org/pl/forum/download/file.php?id=429
REM -----------------------------------------------------------------------------------

Function code25i(Optional data$, Optional size as integer) As String
code25i=""
if IsMissing(data) or data="" then goto errend
if IsMissing(size) then size=0
if size > 80 then goto errend
DIM count As Integer		'licznik do pętli
DIM count2 As Integer		'licznik do pętli
DIM codebar As String
DIM datastr As String
DIM znak(12) As String
codebar=""
datastr=""
if data="0" and size=0 then goto errend	'przerywa gdy brak danyh
if size mod 2 <> 0 then goto errend	'przerywa gdy nieparzysta długość
znak(0) = "NNWWN"
znak(1) = "WNNNW"
znak(2) = "NWNNW"
znak(3) = "WWNNN"
znak(4) = "NNWNW"
znak(5) = "WNWNN"
znak(6) = "NWWNN"
znak(7) = "NNNWW"
znak(8) = "WNNWN"
znak(9) = "NWNWN"
znak(10) = "wNnNn"	'start
znak(11) = "WnNw"	'stop
datastr = CStr (data)		'zmienia liczbe na znaki
sizedata = Len (datastr)	'liczy ilość znaków
if sizedata=0 then goto errend
if sizedata > 80 then		'przycina zbyt długi ciąg
	count = sizedata - 79
	datastr = Mid(datastr,count)
end if
if size <> 0 then 			'dostosowuje długość ciągu
	if sizedata < size then	'gdy za krotki
		for count = 1 to size-sizedata
			datastr = "0" & datastr
		Next count
	end if
	if sizedata > size then	'gdy za długi
		datastr = Mid(datastr,sizedata-size+1)
	end if
end if
sizedata = Len (datastr)	'liczy ilość znaków
for count=1 to sizedata	'przerywa gdy nieobsługiwany znak
	if Asc(Mid(datastr,count,1)) < 48 then goto errend	'przerywa gdy nieobsługiwany znak
	if Asc(Mid(datastr,count,1)) > 57 then goto errend	'przerywa gdy nieobsługiwany znak
Next count
if sizedata mod 2 <> 0 then datastr = "0" & datastr	'dodaje zero wiodące gdy nieparzysta ilosc znakow
codebar = znak(10)	' START
for count=1 to sizedata step 2
	for count2=1 to 5
		codebar = codebar & Mid(znak(Mid(datastr,count,1)),count2,1)
		codebar = codebar & Mid(LCase(znak(Mid(datastr,count+1,1))),count2,1)
	Next count2
Next count
code25i = codebar & znak(11)	'STOP
errend:
End Function

Oraz wersja ITF-14.
ITF-14 jest odmianą kodu 2of5 zaadoptowaną na potrzeby organizacji GS1.
Różnica polega na wymuszonej stałej długości 14 cyfr oraz obowiązkowej cyfrze kontrolnej.
Działa polecenie ITF14(1234567890) .
Pierwszy argument to zawartość kodu liczba lub cyfry.
W przypadku zbyt krótkiej liczby zera wiodące zostaną dodane automatycznie.
Cyfra kontrolna zostanie dodana automatycznie.
Jeśli podamy liczbę z błędną cyfrą kontrolną kod nie wyświetli się.

Kod: Zaznacz cały

REM  *****  BASIC  *****
REM V1.3 14-11-2012
REM Barcode creator ITF14 by TN
REM Funkcja generuje kod przeplatany 2 z 5 zgodny z ITF14
REM 
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM
REM Działa polecenie
REM ITF14(znaki cyfr lub liczba)
REM 
REM ! UWAGA !
REM Do poprawnego działania wymagana jest odpowiednia czcionka barcode.ttf
REM http://user.services.openoffice.org/pl/forum/download/file.php?id=429
REM -----------------------------------------------------------------------------------

Function itf14(optional data$) As String
itf14=""
if IsMissing(data) or data="0" or data="" then goto errend	'przerywa gdy brak danyh
DIM count As Integer		'licznik do pętli
DIM count2 As Integer		'licznik do pętli
DIM size As Integer
DIM codebar As String
DIM znak(10) As String
size = len(data)
codebar=""
if size>14 then goto errend
for count=1 to size	'przerywa gdy nieobsługiwany znak
	if Asc(Mid(data,count,1)) < 48 then goto errend	'przerywa gdy nieobsługiwany znak
	if Asc(Mid(data,count,1)) > 57 then goto errend	'przerywa gdy nieobsługiwany znak
Next count
if size < 13 then
	for count = 1 to 13-size
		data = "0" & data
	Next count
end if
size = len(data)
if size=13 then data = data & CStr(itf14cs(data))
if size=14 then if CStr(mid(data,14,1))<>itf14cs(data) then goto errend
znak(0) = "NNWWN"
znak(1) = "WNNNW"
znak(2) = "NWNNW"
znak(3) = "WWNNN"
znak(4) = "NNWNW"
znak(5) = "WNWNN"
znak(6) = "NWWNN"
znak(7) = "NNNWW"
znak(8) = "WNNWN"
znak(9) = "NWNWN"
for count=1 to 14 step 2
	for count2=1 to 5
		codebar = codebar & Mid(znak(Mid(data,count,1)),count2,1)
		codebar = codebar & Mid(LCase(znak(Mid(data,count+1,1))),count2,1)
	Next count2
Next count
itf14 = "wNnNn" & codebar & "WnNw"
errend:
End Function

Function itf14cs(a1 as string) as integer
	DIM c1 as integer
	itf14cs=0
	for c1=1 to 13 step 2
		itf14cs = itf14cs + CInt(mid(a1,c1,1))
	Next c1
	itf14cs = itf14cs * 3
	for c1=2 to 12 step 2
		itf14cs = itf14cs + CInt(mid(a1,c1,1))
	Next c1
	itf14cs = 10 - (itf14cs mod 10)
	if itf14cs = 10 then itf14cs = 0
End Function

Generator wraz z czcionką generuje kody typu slim (niskie),
bez cyfr czytelnych dla człowieka, tylko kod kreskowy.

Funkcja CHECKSUM_MOD_10(1234567890;1).
Funkcja ta generuje sumę kontrolną dla dowolnego ciągu cyfr.
Suma kontrolna jest zgodna z wymaganiami organizacji GS1 (kody EAN).
np. Jeżeli użyjemy ciągu 13 cyfr, dodamy sumę kontrolną i utworzymy kod code25i to taki kod będzie zgodny z ITF14.
Funkcja ma 4 tryby pracy.
Tryb pracy wybieramy podając wartość od 1 do 4 jako drugi parametr:
1 : Generuje i dodaje sumę kontrolną do podanej wartości.
2 : Generuje i zwraca tylko sumę kontrolną.
3 : Sprawdza czy wprowadzona wartość ma poprawną sumę kontrolną, jeśli tak to zwraca wprowadzony ciąg, jeśli nie zwraca pusty ciąg.
4 : Sprawdza czy wprowadzona wartość ma poprawną sumę kontrolną, jeśli tak to zwraca "1" (prawda,true), jeśli nie zwraca "0" (fałsz,false).

Kod: Zaznacz cały

REM  *****  BASIC  *****
REM V1.1 14-11-2012
REM CHECKSUM_MOD_10 by TN
REM This function generates a checksum for any sequence of digits.
REM The checksum is consistent with the requirements of the organization GS1 (EAN codes).
REM 
REM GNU GPL General Public Licence
REM Free to commercial and private use.
REM 
REM CHECKSUM_MOD_10(data ; Optional mode)
REM Creation mode:
REM mode=1: Create and add the checksum. (default)
REM mode=2: Create and return only the checksum.
REM Checking mode:
REM mode=3: If checksum correct, return data.
REM mode=4: Check and return True "1" or False "0".
REM -----------------------------------------------------------------------------------
Function checksum_mod_10$(Optional data$, Optional mode%)
	checksum_mod_10=""
	if IsMissing(data) or data="" or data="0" or len(data)>99 then goto errend	' <- maximum size=99.
	if IsMissing(mode) or mode=0 then mode = 1	' <- default mode 1.
	if mode<0 or mode>4 then
		mode = 1
		msgbox "Creation mode:" & Chr$(13) & "mode=1: Create and add the checksum (default)" & Chr$(13) & "mode=2: Create and return only the checksum" & Chr$(13) & Chr$(13) & "Checking mode:" & Chr$(13) & "mode=3: If checksum correct, return data." & Chr$(13) & "mode=4: Check and return True (1) or False (0)" & Chr$(13) & " ",0,"Mode:"
	end if
	dim a$,c%,size%,check%
	check=0
	size = len(data)
	for c=1 to size
		a = mid(data,c,1)
		if a>9 or a<0 then goto errend
	next c
	if mode=1 or mode=2 then c = size
	if mode=3 or mode=4 then c = size - 1
	do until c<1
		check = check + (cint(mid(data,c,1))*3)
		c = c - 2
	loop
	if mode=1 or mode=2 then c = size - 1
	if mode=3 or mode=4 then c = size - 2
	do until c<1
		check = check + cint(mid(data,c,1))
		c = c - 2
	loop
	check = 10 - (check mod 10)
	if check=10 then check=0
	if mode=1 then checksum_mod_10 = data & check
	if mode=2 then checksum_mod_10 = check
	if mode=3 and cint(mid(data,size,1))=check then checksum_mod_10 = data
	if mode=4 then
		if cint(mid(data,size,1))=check then checksum_mod_10 = 1 else checksum_mod_10 = 0
	end if
	errend:
End Function

Pozdrawiam.
MrTN. OOo 3.3 , Win7 .
ODPOWIEDZ