Forum społeczności użytkowników OpenOffice i LibreOffice

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

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

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