home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library5 / bar3of9.bas next >
Encoding:
BASIC Source File  |  1990-07-19  |  14.2 KB  |  408 lines
  1.  $compile EXE
  2.  $ERROR ALL OFF
  3. $OPTION CNTLBREAK OFF
  4. $SOUND 0
  5.  $LIB ALL OFF
  6.  $LIB LPT ON
  7.  ' barcode printing
  8.  ' losely based on a program in another language by an unknown author
  9.  
  10.  '-=-=-                      -  SPECIFICATIONS -                       -=-=-
  11.  '-=                                                                      =-
  12.  '-=                         W                                 N          =-
  13.  '-=                |  Nominal Width  | Nominal Width  | Nominal Ratio    =-
  14.  '-=     Density    |       of        |      of        |      of          =-
  15.  '-=   (Characters/ | Narrow Bars and | Wide Bars and  | Wide to Narrow   =-
  16.  '-=      Inch)     | Spaces (Inches) | Spaces (Inches)| Element Width    =-
  17.  '-=   -------------+-----------------+----------------+----------------  =-
  18.  '-=      5.730     |     0.0125      |     0.0315     |      2.52        =-
  19.  '-=   -------------+-----------------+----------------+----------------  =-
  20.  '-=                                                                      =-
  21.  '-=-=-                 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-                -=-=-
  22.  '-=-=-  Code 3-of-9 was developed in 1974 by Dr. David C. Allais of   -=-=-
  23.  '-=-=-  Interface Mechanisms, Inc.  It is the most widely used        -=-=-
  24.  '-=-=-  alphanumeric bar code in use. Code 3 of 9 is called this      -=-=-
  25.  '-=-=-  because the original concept provided for 39 data characters. -=-=-
  26.  '-=-=-  The name also describes what has become the general meaning   -=-=-
  27.  '-=-=-  of the phrase, the structure of the code which has 3 wide     -=-=-
  28.  '-=-=-  elements out of a total of 9.                                 -=-=-
  29.  '-=-=-                                                                -=-=-
  30.  '-=-=-  The height should be an exen number and approx 15% of the     -=-=-
  31.  '-=-=-  total code length       -=-=-
  32.  '-=-=-                                                                -=-=-
  33.  '-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  34.  DEFINT a-z
  35. $INCLUDE "pbwindow.inc"
  36.  
  37.  Bar0to2Off% = 0
  38.  Public frc,brc,NarrowSpace$,WideSpace$,NarrowBar$,WideBar$,PrintHead$()
  39.  DIM PrintHead$(30)
  40.  
  41.  '*====================*
  42.  
  43. SUB MakeBlankScreen
  44.  ' this makes the blank window that all others will print in
  45.  IF IsColr THEN
  46.     frc = 7
  47.     brc = 1
  48.  ELSE
  49.     frc = 7
  50.     brc = 0
  51.  END IF
  52.  CALL makeBox(1,27,6,27,frc,brc,2,0,0,-1,-1)
  53.  CALL BoxTitle(2,"3 of 9",-1,-1)
  54.  CALL BoxTitle(5,"Bar Codes",-1,-1)
  55. END SUB
  56.  
  57.  '*====================*
  58.  
  59.  
  60. SUB MainMenu(lastItm)
  61. SHARED itm
  62.  mList$(1) = "Print Data from CONSOLE"
  63.  mlist$(2) = "Print Data from FILE"
  64.  mlist$(3) = "ADD Data to FILE"
  65.  mlist$(4) = "Quit"
  66.  mlist$(5) = ""
  67.  IF IsColr THEN
  68.     CALL BuildMenu(itm,LastItm,0,0,-1,-1,14,4,2,mlist$(),0,4)
  69.  ELSE
  70.     CALL BuildMenu(itm,LastItm,0,0,7,0,15,7,2,mlist$(),0,-1)
  71.  END IF
  72. END SUB
  73.  
  74.  '*====================*
  75.  
  76.  
  77. SUB ClearWindow
  78.  FOR x = 1 TO 4
  79.      CALL PrtEol(x,1)
  80.  NEXT
  81. END SUB
  82.  
  83. SUB  EnterData
  84. SHARED msg$,hmsg$
  85.  
  86.  msg$=""
  87.  hmsg$=""
  88.  CALL ClearWindow
  89.  CALL CtrBox(1,"Enter Message")
  90.  CALL PrtBox(2,1,STRING$(25,CHR$(219)))
  91.  FOR x = 1 TO  25
  92.      CALL PrtAttrBox(2,x,CHR$(219),15+16,7)
  93.      WHILE NOT INSTAT:WEND
  94.      ms$ = INKEY$
  95.      IF ms$=CHR$(13) THEN EXIT FOR
  96.      CALL PrtBox(2,x,ms$)
  97.      msg$=msg$+UCASE$(ms$)
  98.  NEXT
  99.  msg$ = "*"+msg$+"*"
  100.  CALL ClearWindow
  101.  hmsg$=GetHeight$
  102.  CALL ClearWindow
  103. END SUB
  104.  
  105.  '*====================*
  106.  
  107.  
  108. SUB InitializePrintHead
  109.  WideSpace$ = CHR$(0,0,0,0)
  110.  NarrowSpace$ = CHR$(0,0)
  111.  WideBar$ = CHR$(255,255,255)
  112.  NarrowBar$ = CHR$(255)
  113. END SUB
  114.  
  115.  
  116.  '*====================*
  117.  
  118. SUB  FillPrintHead(message$)
  119.  
  120.  'send in message
  121.  FOR x = 1 TO LEN(message$)
  122.      SELECT CASE MID$(message$,x,1)
  123.             CASE "1"
  124.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+WideSpace$+_
  125.                       NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+WideBar$
  126.             CASE "2"
  127.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+WideSpace$+_
  128.                       NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+WideBar$
  129.             CASE "3"
  130.                  Bar$=WideBar$+NarrowSpace$+WideBar$+WideSpace$+NarrowBar$+_
  131.                       NarrowSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  132.             CASE "4"
  133.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+WideSpace$+_
  134.                       WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+WideBar$
  135.             CASE "5"
  136.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+WideSpace$+WideBar$+_
  137.                       NarrowSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  138.             CASE "6"
  139.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+WideSpace$+WideBar$+_
  140.                       NarrowSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  141.             CASE "7"
  142.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+WideSpace$+_
  143.                       NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+WideBar$
  144.             CASE "8"
  145.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+WideSpace$+_
  146.                       NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+NarrowBar$
  147.             CASE "9"
  148.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+WideSpace$+_
  149.                       NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+NarrowBar$
  150.             CASE "0"
  151.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+WideSpace$+_
  152.                       WideBar$+NarrowSpace$+WideBar$+NarrowSpace$+NarrowBar$
  153.             CASE "A"
  154.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  155.                       NarrowBar$+WideSpace$+NarrowBar$+NarrowSpace$+WideBar$
  156.             CASE "B"
  157.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+_
  158.                       NarrowBar$+WideSpace$+NarrowBar$+NarrowSpace$+WideBar$
  159.             CASE "C"
  160.                  Bar$=WideBar$+NarrowSpace$+WideBar$+NarrowSpace$+_
  161.                       NarrowBar$+WideSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  162.             CASE "D"
  163.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  164.                       WideBar$+WideSpace$+NarrowBar$+NarrowSpace$+WideBar$
  165.             CASE "E"
  166.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  167.                       WideBar$+WideSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  168.             CASE "F"
  169.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+_
  170.                       WideBar$+WideSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  171.             CASE "G"
  172.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  173.                       NarrowBar$+WideSpace$+WideBar$+NarrowSpace$+WideBar$
  174.             CASE "H"
  175.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  176.                       NarrowBar$+WideSpace$+WideBar$+NarrowSpace$+NarrowBar$
  177.             CASE "I"
  178.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+_
  179.                       NarrowBar$+WideSpace$+WideBar$+NarrowSpace$+NarrowBar$
  180.             CASE "J"
  181.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  182.                       WideBar$+WideSpace$+WideBar$+NarrowSpace$+NarrowBar$
  183.             CASE "K"
  184.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  185.                       NarrowBar$+NarrowSpace$+NarrowBar$+WideSpace$+WideBar$
  186.             CASE "L"
  187.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+_
  188.                       NarrowBar$+NarrowSpace$+NarrowBar$+WideSpace$+WideBar$
  189.             CASE "M"
  190.                  Bar$=WideBar$+NarrowSpace$+WideBar$+NarrowSpace$+_
  191.                       NarrowBar$+NarrowSpace$+NarrowBar$+WideSpace$+NarrowBar$
  192.             CASE "N"
  193.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  194.                       WideBar$+NarrowSpace$+NarrowBar$+WideSpace$+WideBar$
  195.             CASE "O"
  196.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  197.                       WideBar$+NarrowSpace$+NarrowBar$+WideSpace$+NarrowBar$
  198.             CASE "P"
  199.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+_
  200.                       WideBar$+NarrowSpace$+NarrowBar$+WideSpace$+NarrowBar$
  201.             CASE "Q"
  202.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  203.                       NarrowBar$+NarrowSpace$+WideBar$+WideSpace$+WideBar$
  204.             CASE "R"
  205.                  Bar$=WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  206.                       NarrowBar$+NarrowSpace$+WideBar$+WideSpace$+NarrowBar$
  207.             CASE "S"
  208.                  Bar$=NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+_
  209.                       NarrowBar$+NarrowSpace$+WideBar$+WideSpace$+NarrowBar$
  210.             CASE "T"
  211.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+_
  212.                       WideBar$+NarrowSpace$+WideBar$+WideSpace$+NarrowBar$
  213.             CASE "U"
  214.                  Bar$=WideBar$+WideSpace$+NarrowBar$+NarrowSpace$+_
  215.                       NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+WideBar$
  216.             CASE "V"
  217.                  Bar$=NarrowBar$+WideSpace$+WideBar$+NarrowSpace$+_
  218.                       NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+WideBar$
  219.             CASE "W"
  220.                  Bar$=WideBar$+WideSpace$+WideBar$+NarrowSpace$+_
  221.                       NarrowBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  222.             CASE "X"
  223.                  Bar$=NarrowBar$+WideSpace$+NarrowBar$+NarrowSpace$+_
  224.                       WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+WideBar$
  225.             CASE "Y"
  226.                  Bar$=WideBar$+WideSpace$+NarrowBar$+NarrowSpace$+_
  227.                       WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  228.             CASE "Z"
  229.                  Bar$=NarrowBar$+WideSpace$+WideBar$+NarrowSpace$+_
  230.                       WideBar$+NarrowSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  231.             CASE "-"
  232.                  Bar$=NarrowBar$+WideSpace$+NarrowBar$+NarrowSpace$+_
  233.                       NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+WideBar$
  234.             CASE "."
  235.                  Bar$=WideBar$+WideSpace$+NarrowBar$+NarrowSpace$+_
  236.                       NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+NarrowBar$
  237.             CASE " "
  238.                  Bar$=NarrowBar$+WideSpace$+WideBar$+NarrowSpace$+_
  239.                       NarrowBar$+NarrowSpace$+WideBar$+NarrowSpace$+NarrowBar$
  240.             CASE "*"
  241.                  Bar$=NarrowBar$+WideSpace$+NarrowBar$+NarrowSpace$+_
  242.                       WideBar$+NarrowSpace$+WideBar$+NarrowSpace$+NarrowBar$
  243.  
  244.             CASE "$"
  245.                  Bar$=NarrowBar$+WideSpace$+NarrowBar$+WideSpace$+_
  246.                       NarrowBar$+WideSpace$+NarrowBar$+NarrowSpace$+NarrowBar$
  247.             CASE "/"
  248.                  Bar$=NarrowBar$+WideSpace$+NarrowBar$+WideSpace$+_
  249.                       NarrowBar$+NarrowSpace$+NarrowBar$+WideSpace$+NarrowBar$
  250.             CASE "+"
  251.                  Bar$=NarrowBar$+WideSpace$+NarrowBar$+NarrowSpace$+_
  252.                       NarrowBar$+WideSpace$+NarrowBar$+WideSpace$+NarrowBar$
  253.             CASE "%"
  254.                  Bar$=NarrowBar$+NarrowSpace$+NarrowBar$+WideSpace$+_
  255.                       NarrowBar$+WideSpace$+NarrowBar$+WideSpace$+NarrowBar$
  256.      END SELECT
  257.      PrintHead$(x)=Bar$
  258.  NEXT
  259. END SUB
  260.  
  261.  
  262.  '*====================*
  263.  
  264. SUB PrintData
  265. SHARED hmsg$,msg$
  266. LOCAL Temp$(),English$()
  267.  DIM DYNAMIC English$(30)
  268.  FOR x = 1 TO LEN(msg$)
  269.      English$(x) = MID$(msg$,x,1)
  270.      IF (x <> 15) AND (x <> 25)  THEN
  271.         IF x>2 AND (x MOD 2) > 0 THEN English$=English$+" "
  272.      END IF
  273.  NEXT
  274.  
  275.  WIDTH "LPT1:",255'disable line feeds
  276.  LPRINT CHR$(27,51,2);
  277.  
  278.  'get vals for dot graphics command
  279.  Columns = 21
  280.  n1 = columns MOD 256
  281.  n2 = columns\256
  282.  
  283.  CALL ClearWindow
  284.  CALL PrtBox(1,1,"Printing ")
  285.  height = ABS(VAL(hmsg$))
  286.  IF height <2 THEN height =2
  287.  FOR h = 1 TO height
  288.      FOR n = LEN(msg$) TO 1 STEP -1
  289.          CALL prtBox(2,1+n," ")
  290.      NEXT
  291.      FOR m = 1 TO LEN(msg$)
  292.          CALL PrtBox(2,m,English$(m))
  293.          LPRINT CHR$(27,76,n1,n2);printhead$(m);narrowspace$;
  294.      NEXT
  295.  
  296.      IF (h MOD 2) = 0 THEN LPRINT CHR$(27,74,19);
  297.      LPRINT
  298.      CALL PrtBox(3,1,"Pass" + STR$(h) + " complete")
  299.  NEXT h
  300.  
  301.  'reset printer
  302.  LPRINT CHR$(27);"@"
  303.  LPRINT English$;msg$
  304.  LPRINT
  305.  
  306.  ERASE English$
  307.  
  308. END SUB
  309.  
  310.  
  311.  '*====================*
  312.  
  313. SUB LoadFromDisk
  314. SHARED message$,hmsg$
  315.  CALL ClearWindow
  316.  hmsg$=GetHeight$
  317.  CALL ClearWindow
  318.  OPEN "BarCode.Dat" FOR INPUT AS # 1
  319.  WHILE NOT EOF(1)
  320.      INPUT #1,msg$
  321.      msg$="*"+msg$+"*"
  322.  WEND
  323.  CLOSE #1
  324. END SUB
  325.  
  326.  '*====================*
  327.  
  328.  
  329. SUB WriteToDisk
  330. SHARED msg$
  331.  OPEN "BarCode.dat" FOR APPEND AS #1
  332.  DO
  333.      msg$=""
  334.      CALL ClearWindow
  335.      CALL CtrBox(1,"Enter Message")
  336.      CALL PrtBox(2,1,STRING$(25,CHR$(219)))
  337.      FOR x = 1 TO  25
  338.          CALL PrtAttrBox(2,x,CHR$(219),15+16,7)
  339.          WHILE NOT INSTAT:WEND
  340.          ms$ = INKEY$
  341.          IF ms$=CHR$(13) THEN EXIT FOR
  342.          CALL PrtBox(2,x,ms$)
  343.          msg$=msg$+UCASE$(ms$)
  344.      NEXT
  345.      IF msg$="" THEN EXIT LOOP
  346.      msg$ = "*"+msg$+"*"
  347.      PRINT #1,msg$
  348.      CALL ClearWindow
  349.  LOOP
  350.  CALL ClearWindow
  351.  CLOSE 1
  352. END SUB
  353.  
  354.  '*====================*
  355.  
  356.  
  357.  FUNCTION GetHeight$
  358.  CALL CtrBox(1,"Enter Height")
  359.  Spot = (PBWW(1)/2) -1
  360.  CALL PrtBox(2,Spot+1,STRING$(2,CHR$(219)))
  361.  FOR x = 1 TO  2
  362.      CALL PrtAttrBox(2,Spot+x,CHR$(219),15+16,7)
  363.      WHILE NOT INSTAT:WEND
  364.      ms$ = INKEY$
  365.      IF ms$=CHR$(13) THEN EXIT FOR
  366.      CALL PrtBox(2,spot+x,ms$)
  367.      hmsg$=hmsg$+ms$
  368.  NEXT
  369.  ' make it an even number
  370.  ht = VAL(hmsg$)
  371.  IF ht MOD 2 <> 0 THEN INCR ht
  372.  GETHEIGHT$ = MID$(STR$(ht),2)
  373.  
  374.  END Function
  375.  
  376.  '*====================*
  377.  
  378.  
  379.  
  380.  
  381.  CLS'later change to a save the entire window and then cls and restore at end
  382.  
  383.  CALL MakeBlankScreen
  384.  CALL InitializePrintHead
  385.  ItmNum = 1
  386.  DO
  387.      CALL MainMenu(itmNum)
  388.      SELECT CASE itm
  389.             CASE 1
  390.                  CALL EnterData
  391.                  CALL FillPrintHead(msg$)
  392.                  CALL PrintData
  393.             CASE 2
  394.                  CALL LoadFromDisk
  395.                  CALL FillPrintHead(msg$)
  396.                  CALL PrintData
  397.             CASE 3
  398.                  CALL WriteToDisk
  399.             CASE 4
  400.                  CLS
  401.                  END (0)
  402.                  CALL ClearWindow
  403.                  CALL removeBox
  404.      END SELECT
  405.      ItmNum = Itm
  406.      Itm = 0
  407.  LOOP
  408.