home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / general / label_maker.amos / label_maker.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1991-06-13  |  12.4 KB  |  514 lines

  1. '******************************************* 
  2. '*****    CASSETTE LABEL MAKER v2.0    *****   
  3. '*****        (c) John J. Cassar       ***** 
  4. '*****             11/8/90             ***** 
  5. '******************************************* 
  6. Set Buffer 15
  7. Close Workbench 
  8. Unpack 6 To 0
  9. Get Palette 0
  10. Limit Mouse 130,44 To 445,290
  11. Dim A$(60),B$(60),CODE$(5),W(20,30)
  12. Global A,CC,A$,A$(),B$(),W(),CODE$(),ANS,ERR
  13. Pen 0 : Paper 13
  14. Wind Open 1,80,94,34,19,0
  15. Wind Open 2,48,16,38,2,0
  16. Wind Open 3,48,40,38,2,0
  17. Window 0 : INIT_ZONES : CLEAR_WP : PCODE_SETUP
  18. For T=0 To 60
  19.    A$(T)=Space$(30) : B$(T)=Space$(30)
  20. Next T
  21. ' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  22. Curs Off 
  23. While Z<>15
  24.    While Mouse Key=0 : Wend 
  25.    Z=Mouse Zone
  26.    On Z Proc LAB_LOAD,LAB_SAVE,GO_PRINTER,NEW,TITLES,HELP,P11,P12,P13,P21,P22,P23
  27. Wend 
  28. Window 0 : Cls 0
  29. Run "AutoExec.AMOS"
  30. End 
  31. ' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=  
  32. Procedure ENTER_LINE[CX,CY,W]
  33. A$=""
  34. Locate CX,CY
  35. Repeat 
  36. X$=Inkey$
  37.    If Asc(X$)>31 and Asc(X$)<127 and Len(A$)<W
  38.       A$=A$+X$
  39.       Print X$;
  40.    End If 
  41.    If Asc(X$)=8 and Len(A$)>0
  42.       A$=Left$(A$,Len(A$)-1)
  43.       Print X$;" ";X$;
  44.    End If 
  45. Until Asc(X$)=13
  46. End Proc
  47. Procedure MIDDLE[CX,CY,W]
  48. R=(W-Len(A$))/2
  49. A$=String$(" ",R)+A$
  50. R=W-Len(A$)
  51. A$=A$+Space$(R)
  52. Locate CX,CY : Print A$
  53. End Proc
  54. Procedure CLEAR_WP
  55.  Ink 0,13
  56.  For I=0 To 17
  57.    For T=0 To 29
  58.       W(I,T)=Asc(" ")
  59.    Next T
  60.  Next I
  61. End Proc
  62. Procedure ENTER_LIST
  63. Home : PX=0 : PY=0 : CC=0 : ZZ=0 : Curs On 
  64. Memorize X 
  65.  Repeat 
  66.    X$=Inkey$ : C=Asc(X$)
  67.    If C=44 Then C=32 : X$=" "
  68.    If C>31 and C<127 and PX<30
  69.     W(PY,PX)=C
  70.     Print X$; : Inc PX
  71.    End If 
  72.    If C=13 and PY<17
  73.     Inc PY : PX=0
  74.     Cdown : Remember X 
  75.    End If 
  76.    If C=8 and PX>0
  77.     Dec PX
  78.     W(PY,PX)=Asc(" ")
  79.     Cleft : Print " "; : Cleft 
  80.    End If 
  81.    If C=27 Then CC=27
  82.    If C=28 and PX<30 Then Inc PX : Cright 
  83.    If C=29 and PX>0 Then Dec PX : Cleft 
  84.    If C=30 and PY>0 Then Dec PY : Cup 
  85.    If C=31 and PY<17 Then Inc PY : Cdown 
  86.    If Mouse Key<>0 Then ZZ=Mouse Zone
  87.    If ZZ=14 Then CC=27
  88.    If ZZ=13
  89.       Bob 13,298,70,10
  90.       Wait 20 : Clw : ZZ=0 : CLEAR_WP
  91.       Bob Off 13
  92.    End If 
  93.  Until CC=27
  94.  Bob 14,48,70,11
  95.  Wait 20 : Window 0 : Every Off 
  96. End Proc
  97. Procedure CLA_SORT[G]
  98.  For I=0 To 17
  99.    A$(G)=""
  100.    For T=0 To 29
  101.       A$(G)=A$(G)+Chr$(W(I,T))
  102.    Next T
  103.    Inc G
  104.  Next I
  105.  Bob Off 14 : Wait Vbl 
  106.  Ink 14,12 : Text 56,80,"    "
  107.  Text 302,80,"     "
  108. End Proc
  109. Procedure CLB_SORT[G]
  110.  For I=0 To 17
  111.    B$(G)=""
  112.    For T=0 To 29
  113.       B$(G)=B$(G)+Chr$(W(I,T))
  114.    Next T
  115.    Inc G
  116.  Next I
  117.  Bob Off 14 : Wait Vbl 
  118.  Ink 14,12 : Text 56,80,"    "
  119.  Text 302,80,"     "
  120. End Proc
  121. Procedure INIT_ZONES
  122. Reserve Zone 17
  123. Set Zone 1,382,10 To 452,31
  124. Set Zone 2,464,10 To 532,31
  125. Set Zone 3,545,10 To 612,31
  126. Set Zone 4,382,39 To 452,60
  127. Set Zone 5,464,39 To 532,60
  128. Set Zone 6,545,39 To 612,60
  129. Set Zone 7,382,95 To 452,116
  130. Set Zone 8,464,95 To 532,116
  131. Set Zone 9,545,95 To 612,116
  132. Set Zone 10,382,145 To 452,166
  133. Set Zone 11,464,145 To 532,166
  134. Set Zone 12,545,145 To 612,166
  135. Set Zone 13,298,70 To 348,85
  136. Set Zone 14,50,70 To 100,85
  137. Set Zone 15,0,0 To 5,5
  138. End Proc
  139. Procedure YES_NON
  140. Clear Key : Pen 11 : Paper 13
  141. Locate 18,17 : Print "Please Confirm";
  142. Locate 17,20 : Print Border$(Zone$(" YES ",16),1)
  143. Locate 23,20 : Print " or  ";Border$(Zone$(" NO  ",17),1)
  144. ANS=0 : Curs Off 
  145. While ANS=0
  146.  While Mouse Key=0 : Wend 
  147.   Z=Mouse Zone
  148.   If Z=16
  149.    ANS=1
  150.   End If 
  151.   If Z=17
  152.    ANS=2
  153.   End If 
  154. Wend 
  155. End Proc
  156. Procedure WP_PUTA[G]
  157.  Curs Off 
  158.  For L=0 To 17
  159.   Print A$(G)
  160.   For E=0 To 29
  161.    CODE=Asc(Mid$(A$(G),E+1,1))
  162.    If CODE>0 Then W(L,E)=CODE Else W(L,E)=32
  163.   Next E
  164.   Inc G
  165.  Next L
  166. End Proc
  167. Procedure WP_PUTB[G]
  168.  Curs Off 
  169.  For L=0 To 17
  170.   Print B$(G)
  171.   For E=0 To 29
  172.    CODE=Asc(Mid$(B$(G),E+1,1))
  173.    If CODE>0 Then W(L,E)=CODE Else W(L,E)=32
  174.   Next E
  175.   Inc G
  176.  Next L
  177. End Proc
  178. Procedure HEADING[CMN,PGE]
  179.  Ink 14,12 : Text 56,80,"Done" : Text 302,80,"Clear"
  180.  Ink 14,8 : Text 110,80," Column "+Str$(CMN)+" -- Page "+Str$(PGE)
  181.  Window 1 : Clw 
  182. End Proc
  183. Procedure CLEAR_HEAD
  184.  Ink 14,12 : Text 56,80,"    " : Text 302,80,"     "
  185.  Ink 14,8 : Text 108,80,"                      "
  186. End Proc
  187. Procedure PAGE_PRINT[G]
  188.    Restore DAT2
  189.    If G=3 Then Restore DAT3
  190.    If G=4 Then Restore DAT4
  191.    If G=5 Then Restore DAT5
  192.    If G=6 Then Restore DAT6
  193.    I=12 : A$="" : While A$<>"xxx"
  194.    Read A$
  195.    If A$<>"xxx" Then Locate 8,I : Print A$
  196.    Inc I : Wend 
  197.    Locate 13,29 : Print "Press any key to continue"
  198.    Clear Key : Wait Key 
  199.    For I=29 To 12 Step -1 : Locate 8,I : Print Space$(35) : Next I
  200. DAT2:
  201.    Data " Cassette Label Maker allows you to"
  202.    Data "enter up to three pages of text."," "
  203.    Data "  Each page contains two columns of"
  204.    Data "17 lines by 30 letters."," "
  205.    Data "  Select the page you wish to enter"
  206.    Data "and type  your  list  in the normal"
  207.    Data "way. You can use the cursor keys to"
  208.    Data "move across the page."," "
  209.    Data "  Starting a line with  an asterisk"
  210.    Data "(*) informs  the  printer that this"
  211.    Data "line is to be printed in italics.","xxx"
  212. DAT3:
  213.    Data "  To clear a  page place mouse over"
  214.    Data "(Clear) and press mouse button."," "
  215.    Data "  When you have  finished, entering"
  216.    Data "a page,  press the (Esc)ape key  or"
  217.    Data "the (Done) key.","xxx"
  218. DAT4:
  219.    Data "  (Titles)  This command allows you"
  220.    Data "to enter up to two cassette titles."
  221.    Data "Two for the front-side and  two for"
  222.    Data "the back-side of the label."," "
  223.    Data "  (New) clears all the memory ready"
  224.    Data "for a new label. Any data in memory"
  225.    Data "will be lost."," "
  226.    Data "  Labels  can  be (Save)d and  then"
  227.    Data "(Load)ed back using the appropriate"
  228.    Data "buttons.","xxx"
  229. DAT5:
  230.    Data "  To  print  your labels  press the"
  231.    Data "(Print)  button.       The  printer"
  232.    Data "control codes  are set for an Epson"
  233.    Data "compatable printer."," "
  234.    Data "  If you have a  different  printer"
  235.    Data "and wish to change them , these are"
  236.    Data "the required codes:-"," "
  237.    Data "1. Normal Sized / Double Strike"
  238.    Data "   and Emphasized"
  239.    Data "2. Compressed / Double Strike"
  240.    Data "3. Compressed / Single Strike"
  241.    Data "4. 10/72 inch line spacing"
  242.    Data "5. Set Italics Mode"
  243.    Data "6. Release Italics Mode","xxx"
  244. DAT6:
  245.    Data "  Control  Codes  must  be entered"
  246.    Data "using this format:-"," "
  247.    Data "EXAMPLE:-"," "
  248.    Data "  The code to set an Epson printer"
  249.    Data "to select  Compressed  and  Double"
  250.    Data "Strike printing is:"
  251.    Data "       Chr$(27);"+Chr$(34)+"!"+Chr$(34)+";Chr$(22)"," "
  252.    Data "  This is translated to:"
  253.    Data "             27 33 24"," "
  254.    Data "  As can be seen the letter (!) is"
  255.    Data "translated to 33 decimal."," "
  256.    Data "xxx"
  257. End Proc
  258. ' ---------------------------- 
  259. Procedure LAB_LOAD
  260. On Error Goto HELP
  261. Bob 1,382,10,1
  262. Wait Vbl 
  263.  SPACES
  264.  CLEAR_HEAD
  265.  Window 1 : Clw : Curs Off 
  266. F$=Fsel$("*.lab",""," Load a Cassette Label ")
  267. If F$="" Then Goto NL
  268. X1=80 : X2=80 : Y1=170 : Y2=180
  269. Ink 4,13 : For I=0 To 58 : Draw X1,Y1 To X2,Y2
  270. X1=X1+4 : X2=X2+4 : Next I
  271. Text 105,155,"Loading..... Please Wait"
  272. Ink 13,13 : X1=312 : X2=312
  273. Open In 1,F$
  274.  For I=0 To 58
  275.   Draw X1,Y1 To X2,Y2
  276.     Input #1,A$(I)
  277.     Input #1,B$(I)
  278.   X1=X1-4 : X2=X2-4
  279.  Next I
  280. Close 1
  281. Text 105,155,"                         "
  282. NL:
  283. Window 0
  284. If F$<>""
  285.    Pen 4 : Paper 13
  286.    Locate 7,2 : Print A$(1) : Locate 7,3 : Print A$(2)
  287.    Locate 7,5 : Print A$(3) : Locate 7,6 : Print A$(4)
  288. End If 
  289. Bob Off 1
  290. Pop Proc
  291. HELP:
  292. ERR=True : Resume Next 
  293. End Proc
  294. Procedure LAB_SAVE
  295. Bob 2,464,10,2
  296. Wait Vbl 
  297.  CLEAR_HEAD
  298.  Window 1 : Clw : Curs Off 
  299. F$=Fsel$("*.lab",""," Save a Cassette Label ")
  300. If F$="" Then Goto NS
  301. Ink 4,13 : Text 100,155,"Saving...... Please Wait"
  302. Open Out 1,F$
  303.  For I=0 To 58
  304.   Print #1,A$(I)
  305.   Print #1,B$(I)
  306.  Next I
  307. Close 1
  308. Text 100,155,"                         "
  309. NS:
  310. Window 0
  311. Bob Off 2
  312. End Proc
  313. Procedure GO_PRINTER
  314. Bob 3,544,10,3
  315.    Window 1 : Clw 
  316.    Ink 0,8 : Text 120,80," Ready for Printing  "
  317.    Window 0 : Curs Off 
  318.    YES_NON
  319.    Window 1 : Clw : Curs Off 
  320.    If ANS=2 Then Goto PDONE
  321.    Text 115,80,"       Printing      "
  322.  SEND_CODE[0]
  323.    Lprint " ";String$("-",39)
  324.    Lprint "|";Space$(38);" |"
  325.    Lprint "|";Space$(38);" |"
  326.    Lprint "| ";A$(1);"  |" : Lprint "| ";A$(2);"  |"
  327.    Lprint "|";String$("-",39);"|"
  328.    Lprint "| ";A$(3);"  |" : Lprint "| ";A$(4);"  |"
  329.    Lprint "|";String$("-",39);"|"
  330.  SEND_CODE[3]
  331.  SEND_CODE[1]
  332.    K=1 : FLAG=0
  333.  For T=5 To 58
  334. Rem -------------
  335.    B$=Left$(A$(T),30)
  336.    Lprint "| ";
  337.    Gosub CHECK_ITALICS
  338.    Lprint B$;"    ";
  339.    Gosub ITALICS_OFF
  340. Rem -------------
  341.    B$=Left$(B$(T),30)
  342.    Gosub CHECK_ITALICS
  343.    Lprint B$;
  344.    Gosub ITALICS_OFF
  345.    Lprint "   |" : K=K+1
  346.    If K=19
  347.      Lprint "|";String$("-",68);"|"
  348.      K=1
  349.    End If 
  350.    Next 
  351. PDONE:
  352.    Text 122,80,"                     "
  353.    Window 0
  354.    Bob Off 3
  355.    Pop Proc
  356. CHECK_ITALICS:
  357.     If Left$(B$,1)="*"
  358.       SEND_CODE[2]
  359.       SEND_CODE[4]
  360.       FLAG=1 : B$=" "+Mid$(B$,2,29)
  361.     End If 
  362. Return 
  363. ITALICS_OFF:
  364.     If FLAG=1
  365.       SEND_CODE[1]
  366.       SEND_CODE[5]
  367.     End If 
  368. Return 
  369. End Proc
  370. Procedure PCODE_SETUP
  371.    On Error Proc PFIX
  372.    Resume Label PFDONE
  373.    Open In 1,"df0:s/Lab.Config"
  374.      For I=0 To 5
  375.        Input #1,CODE$(I)
  376.      Next I
  377.    Close 1
  378. PFDONE:
  379. End Proc
  380. Procedure PFIX
  381. '    *************        Setting for my printer        **************   
  382. '    *************         A Panasonic KX-P1081         ************** 
  383. '    (0)Print style 24        - (1)Print style 22 - (2)Print style 6   
  384. '    (3)Line space 10/72 inch - (4)Set Italics on - (5)Set Itlaics off   
  385.    Restore CDS
  386.    For I=0 To 5 : Read CODE$(I) : Next I
  387. CDS:
  388.    Data "27 33 24","27 33 22","27 33 6"
  389.    Data "27 65 10","27 52","27 53"
  390. Resume Label 
  391. End Proc
  392. Procedure SEND_CODE[G]
  393.   A$=CODE$(G) : A=Len(A$) : C$=""
  394.   For T=1 To A
  395.     B$=Mid$(A$,T,1)
  396.     If B$<>" " Then C$=C$+B$
  397.     If B$=" " or T=A Then Lprint Chr$(Val(C$)); : C$=""
  398.   Next T
  399. End Proc
  400. Procedure NEW
  401.    Bob 4,382,39,4
  402.    Window 1 : Clw : Window 0
  403.    YES_NON
  404.    If ANS=2 Then Goto CON_N
  405.    SPACES : CLEAR_HEAD : CLEAR_WP
  406.    For T=0 To 60
  407.       A$(T)=Space$(30) : B$(T)=Space$(30)
  408.    Next T
  409.    Window 2 : Clw : Window 3 : Clw 
  410. CON_N:
  411.    Window 1 : Clw : Window 0 : Bob Off 4
  412. End Proc
  413. Procedure SPACES
  414.     A=60
  415.     For T=0 To 60
  416.      A$(T)=Space$(30) : B$(T)=Space$(30)
  417.     Next T
  418. End Proc
  419. Procedure TITLES
  420. Restore DAT1
  421.    Pen 4 : Paper 13
  422.    Window 2 : Clw : Window 3 : Clw : Window 0
  423.    Bob 5,460,39,5 : Curs On 
  424.     For T=1 To 2
  425.       Read F
  426.       ENTER_LINE[7,F,36]
  427.       MIDDLE[7,F,36] : A$(T)=A$
  428.       MIDDLE[7,F+3,36] : A$(T+2)=A$
  429.     Next T
  430. DAT1:
  431.    Data 2,3
  432.    Curs Off : Bob Off 5
  433. End Proc
  434. Procedure HELP
  435.    Bob 6,544,39,6
  436.    CLEAR_HEAD
  437.    Ink 14,8 : Text 108,80,"         Help"
  438.    Window 1 : Clw : Window 0 : Pen 4 : Paper 13
  439.    PAGE_PRINT[2] : PAGE_PRINT[3]
  440.    PAGE_PRINT[4] : PAGE_PRINT[5]
  441.    Locate 15,13 : Print "Do you wish to change"
  442.    Locate 15,15 : Print " the printer codes ?"
  443.    YES_NON
  444.    Window 1 : Clw : If ANS=2 Then Goto NON
  445.    Window 0 : PAGE_PRINT[6] : Window 1 : Clw 
  446.    CHGE=False
  447.    For I=0 To 5
  448.      Ink 4,13
  449.      Text 85,120," The current setting for this"
  450.      Text 85,130," codes is "+CODE$(I) : QW$=CODE$(I)
  451.      Read Q$ : Text 85,170,"Enter new code to select"
  452.      Ink 6,13 : Text 85,146,String$("-",28) : Ink 0
  453.      Text 85,185,Q$ : Read Q$ : Text 85,193,Q$
  454.      Locate 0,14 : Input CODE$(I)
  455.      If CODE$(I)=""
  456.        CODE$(I)=QW$
  457.      Else 
  458.        CHGE=True
  459.      End If 
  460.      Clw 
  461.    Next I
  462.    If CHGE=False Then Goto NON
  463.    Open Out 1,"df0:s/Lab.Config"
  464.    For I=0 To 5
  465.     Print #1,CODE$(I)
  466.    Next I
  467.    Close 1
  468.    Clw : Window 0
  469. NON:
  470.    Curs Off : Ink 14,8 : Text 108,80,"                "
  471.    Bob Off 6
  472.  Data "Normal Sized/Double Strike","Emphasized printing"
  473.  Data "Size Compressed/Double Strike","printing"
  474.  Data "Size Compressed/Single Strike","printing"
  475.  Data "   10/72 inch line spacing"," "
  476.  Data "      Set Italics Mode"," "
  477.  Data "    Release Italics Mode"," "
  478. End Proc
  479. Procedure P11
  480.    Bob 7,382,95,7
  481.     HEADING[1,1] : WP_PUTA[5]
  482.     ENTER_LIST : CLA_SORT[5] : Curs Off 
  483.    Bob Off 7
  484. End Proc
  485. Procedure P12
  486.    Bob 8,462,95,8
  487.     HEADING[1,2] : WP_PUTA[23]
  488.     ENTER_LIST : CLA_SORT[23] : Curs Off 
  489.    Bob Off 8
  490. End Proc
  491. Procedure P13
  492.    Bob 9,543,95,9
  493.     HEADING[1,3] : WP_PUTA[41]
  494.     ENTER_LIST : CLA_SORT[41] : Curs Off 
  495.    Bob Off 9
  496. End Proc
  497. Procedure P21
  498.    Bob 10,382,145,7
  499.     HEADING[2,1] : WP_PUTB[5]
  500.     ENTER_LIST : CLB_SORT[5] : Curs Off 
  501.    Bob Off 10
  502. End Proc
  503. Procedure P22
  504.    Bob 11,464,145,8
  505.     HEADING[2,2] : WP_PUTB[23]
  506.     ENTER_LIST : CLB_SORT[23] : Curs Off 
  507.    Bob Off 11
  508. End Proc
  509. Procedure P23
  510.    Bob 12,544,145,9
  511.     HEADING[2,3] : WP_PUTB[41]
  512.     ENTER_LIST : CLB_SORT[41] : Curs Off 
  513.    Bob Off 12
  514. End Proc