2001-06-14 19:36

     DECLARE FUNCTION code93(tekst AS STRING) AS STRING 'maak zwart/wit bitmap


     FUNCTION code93(tekst AS STRING) AS STRING 'maak zwart/wit bitmap
'
'               CODE93
'
'
'--------------------------------------------------------------
' inizialize VAR`S
      DIM bcode(0 TO 90) AS STRING*9 ' ARRAY MET bitpatterns STRING`S

      DIM barlengte AS INTEGER
      DIM barchar AS INTEGER
      DIM weight AS INTEGER
      DIM CHK1 AS INTEGER
      DIM CHK2 AS INTEGER
      DIM BITMAP AS STRING
      DIM X AS INTEGER

'   -----------------------------------------------------------
'
'
'            BITPAT        C93 CHK VALUA          ASCII -->    C93 CHK VALUA
'
      BCODE(32) ="111010010" '	38	SPACE     CHECKSUM VALUE IS ASCII +6
      BCODE(33) =""
      BCODE(34) =""
      BCODE(35) =""
      BCODE(36) ="111001010" '	39	$         CHECKSUM VALUE IS ASCII +3
      BCODE(37) ="110101110" '	42	%         CHECKSUM VALUE IS ASCII +5
      BCODE(38) =""
      BCODE(39) =""
      BCODE(40) =""
      BCODE(41) =""
      BCODE(42) ="101011110" '	-- 	*         Start/Stop
      BCODE(43) ="101110110" '	41	+         CHECKSUM VALUE IS ASCII -2
      BCODE(44) =""
      BCODE(45) ="100101110" '	36	-         CHECKSUM VALUE IS ASCII -9
      BCODE(46) ="111010100" '	37	.         CHECKSUM VALUE IS ASCII -9
      BCODE(47) ="101101110" '	40	/         CHECKSUM VALUE IS ASCII -7

      BCODE(48) ="100010100" '	0	0	  CHECKSUM VALUE IS ASCII -48
      BCODE(49) ="101001000" '	1	1	  CHECKSUM VALUE IS ASCII -48
      BCODE(50) ="101000100" '	2	2	  CHECKSUM VALUE IS ASCII -48
      BCODE(51) ="101000010" '	3	3	  CHECKSUM VALUE IS ASCII -48
      BCODE(52) ="100101000" '	4	4	  CHECKSUM VALUE IS ASCII -48
      BCODE(53) ="100100100" '	5	5	  CHECKSUM VALUE IS ASCII -48
      BCODE(54) ="100100010" '	6	6	  CHECKSUM VALUE IS ASCII -48
      BCODE(55) ="101010000" '	7	7	  CHECKSUM VALUE IS ASCII -48
      BCODE(56) ="100010010" '	8	8	  CHECKSUM VALUE IS ASCII -48
      BCODE(57) ="100001010" '	9	9	  CHECKSUM VALUE IS ASCII -48
      BCODE(58) =""
      BCODE(59) =""
      BCODE(60) =""
      BCODE(61) =""
      BCODE(62) =""
      BCODE(63) =""
      BCODE(64) =""
      BCODE(65) ="110101000" '	10	A	  CHECKSUM VALUE IS ASCII -55
      BCODE(66) ="110100100" '	11	B
      BCODE(67) ="110100010" '	12	C
      BCODE(68) ="110010100" '	13	D
      BCODE(69) ="110010010" '	14	E
      BCODE(70) ="110001010" '	15	F
      BCODE(71) ="101101000" '	16	G
      BCODE(72) ="101100100" '	17	H
      BCODE(73) ="101100010" '	18	I
      BCODE(74) ="100110100" '	19	J
      BCODE(75) ="100011010" '	20	K
      BCODE(76) ="101011000" '	21	L
      BCODE(77) ="101001100" '	22	M
      BCODE(78) ="101000110" '	23	N
      BCODE(79) ="100101100" '	24	O
      BCODE(80) ="100010110" '	25	P
      BCODE(81) ="110110100" '	26	Q
      BCODE(82) ="110110010" '	27	R
      BCODE(83) ="110101100" '	28	S
      BCODE(84) ="110100110" '	29	T
      BCODE(85) ="110010110" '	30	U
      BCODE(86) ="110011010" '	31	V
      BCODE(87) ="101101100" '	32	W
      BCODE(88) ="101100110" '	33	X
      BCODE(89) ="100110110" '	34	Y
      BCODE(90) ="100111010" '	35	Z         CHECKSUM VALUE IS ASCII -55




'	BCODE(43) ="100100110" '	43	($)
'	BCODE(44) ="111011010" '	44	(%)
'	BCODE(45) ="111010110" '	45	(/)
'	BCODE(46) ="100110010" '	46	(+)
'	BCODE(47) ="101011110" '	-	* Start/Stop
'
'   --------------------------------------------------------------
'
' calculate checksum   c

      barlengte=LEN(tekst)


      FOR x = 1 TO barlengte
        'print barlengte
       barchar=ASC(MID$(tekst,BARLENGTE,1))

' 	CONVERTING ASCII VALUA TO CHECKSUM VALUA, FOR CHECKSUM CALCULATION
'
       SELECT CASE barchar
       CASE 65 TO 90
        barchar=barchar-55
       CASE 48 TO 57
        barchar=barchar-48
       CASE 47
        barchar=barchar-7
       CASE 45 TO 46
        barchar=barchar-9
       CASE 43
        barchar=barchar-2
       CASE 37
        barchar=barchar+5
       CASE 36
        barchar=barchar+3
       CASE 32
        barchar=barchar+6
       END SELECT
'

       weight=barchar*x


       CHK1=CHK1 + weight
       BARLENGTE=BARLENGTE-1
      NEXT x


'       calculate the check valua
      CHK1=CHK1 MOD 47 ' terug rekenen naar een ascii char


' 	CONVERTING CHECKSUM VALUA BACK TO A ascci valua
'
      SELECT CASE chk1
      CASE 10 TO 35                          ' A-Z
       chk1=chk1+55
      CASE 0 TO 9                          ' 0-9
       chk1=chk1+48
      CASE 40                                ' /
       chk1=chk1+7
      CASE 36 TO 37                          ' - .
       chk1=chk1+9
      CASE 41                                ' +
       chk1=chk1+2
      CASE 42                                ' %
       chk1=chk1-5
      CASE 39                                ' $
       chk1=chk1-3
      CASE 38                                ' SPACE
       chk1=chk1-6
      END SELECT


'------------------------------------------------------------

' calculate checksum   k

      TEKST=TEKST  +CHR$(CHK1)
      barlengte=LEN(tekst)


      FOR x = 1 TO barlengte
        'print barlengte
       barchar=ASC(MID$(tekst,BARLENGTE,1))

' 	CONVERTING ASCII VALUA TO CHECKSUM VALUA, FOR CHECKSUM CALCULATION
'
       SELECT CASE barchar
       CASE 65 TO 90
        barchar=barchar-55
       CASE 48 TO 57
        barchar=barchar-48
       CASE 47
        barchar=barchar-7
       CASE 45 TO 46
        barchar=barchar-9
       CASE 43
        barchar=barchar-2
       CASE 37
        barchar=barchar+5
       CASE 36
        barchar=barchar+3
       CASE 32
        barchar=barchar+6
       END SELECT
'

       weight=barchar*x


       CHK2=CHK2 + weight
       BARLENGTE=BARLENGTE-1
      NEXT x


'       calculate the check valua
      CHK2=CHK2 MOD 47 ' terug rekenen naar een ascii char



' 	CONVERTING CHECKSUM VALUA BACK TO A ascci valua
'
      SELECT CASE chk2
      CASE 10 TO 35                          ' A-Z
       chk2=chk2+55
      CASE 0 TO 9                          ' 0-9
       chk2=chk2+48
      CASE 40                                ' /
       chk2=chk2+7
      CASE 36 TO 37                          ' - .
       chk2=chk2+9
      CASE 41                                ' +
       chk2=chk1+2
      CASE 42                                ' %
       chk2=chk2-5
      CASE 39                                ' $
       chk2=chk2-3
      CASE 38                                ' SPACE
       chk2=chk2-6
      END SELECT



'   --------------------------------------------------------------
'   make 0/1 string for later bitmap conversion


'                       +CHR$(CHK2)  IS NOT NECESERRY BECAUSE IT IS ALREADY
'                                    ADED TO TEKST STRING
      TEKST = "*" + tekst + CHR$(CHK2) + "*"
      PRINT TEKST
      barlengte=LEN(tekst)

      FOR x = 1 TO barlengte
       barchar=ASC(MID$(tekst,x,1))
       BITMAP=BITMAP+BCODE(BARCHAR)


      NEXT x


'   code93= "*"+TEXT +CHK1+CHK2"*"+"11"  -->  start + tekst + CHECKSUM C + CHECKSUM K +stop + 1
      code93= BITMAP + "1"




     END FUNCTION
'----------------------------------------------------------------------------------

2001-06-14 19:36