home *** CD-ROM | disk | FTP | other *** search
AMOS Source Code | 1991-06-13 | 12.4 KB | 514 lines |
- '*******************************************
- '***** CASSETTE LABEL MAKER v2.0 *****
- '***** (c) John J. Cassar *****
- '***** 11/8/90 *****
- '*******************************************
- Set Buffer 15
- Close Workbench
- Unpack 6 To 0
- Get Palette 0
- Limit Mouse 130,44 To 445,290
- Dim A$(60),B$(60),CODE$(5),W(20,30)
- Global A,CC,A$,A$(),B$(),W(),CODE$(),ANS,ERR
- Pen 0 : Paper 13
- Wind Open 1,80,94,34,19,0
- Wind Open 2,48,16,38,2,0
- Wind Open 3,48,40,38,2,0
- Window 0 : INIT_ZONES : CLEAR_WP : PCODE_SETUP
- For T=0 To 60
- A$(T)=Space$(30) : B$(T)=Space$(30)
- Next T
- ' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- Curs Off
- While Z<>15
- While Mouse Key=0 : Wend
- Z=Mouse Zone
- On Z Proc LAB_LOAD,LAB_SAVE,GO_PRINTER,NEW,TITLES,HELP,P11,P12,P13,P21,P22,P23
- Wend
- Window 0 : Cls 0
- Run "AutoExec.AMOS"
- End
- ' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- Procedure ENTER_LINE[CX,CY,W]
- A$=""
- Locate CX,CY
- Repeat
- X$=Inkey$
- If Asc(X$)>31 and Asc(X$)<127 and Len(A$)<W
- A$=A$+X$
- Print X$;
- End If
- If Asc(X$)=8 and Len(A$)>0
- A$=Left$(A$,Len(A$)-1)
- Print X$;" ";X$;
- End If
- Until Asc(X$)=13
- End Proc
- Procedure MIDDLE[CX,CY,W]
- R=(W-Len(A$))/2
- A$=String$(" ",R)+A$
- R=W-Len(A$)
- A$=A$+Space$(R)
- Locate CX,CY : Print A$
- End Proc
- Procedure CLEAR_WP
- Ink 0,13
- For I=0 To 17
- For T=0 To 29
- W(I,T)=Asc(" ")
- Next T
- Next I
- End Proc
- Procedure ENTER_LIST
- Home : PX=0 : PY=0 : CC=0 : ZZ=0 : Curs On
- Memorize X
- Repeat
- X$=Inkey$ : C=Asc(X$)
- If C=44 Then C=32 : X$=" "
- If C>31 and C<127 and PX<30
- W(PY,PX)=C
- Print X$; : Inc PX
- End If
- If C=13 and PY<17
- Inc PY : PX=0
- Cdown : Remember X
- End If
- If C=8 and PX>0
- Dec PX
- W(PY,PX)=Asc(" ")
- Cleft : Print " "; : Cleft
- End If
- If C=27 Then CC=27
- If C=28 and PX<30 Then Inc PX : Cright
- If C=29 and PX>0 Then Dec PX : Cleft
- If C=30 and PY>0 Then Dec PY : Cup
- If C=31 and PY<17 Then Inc PY : Cdown
- If Mouse Key<>0 Then ZZ=Mouse Zone
- If ZZ=14 Then CC=27
- If ZZ=13
- Bob 13,298,70,10
- Wait 20 : Clw : ZZ=0 : CLEAR_WP
- Bob Off 13
- End If
- Until CC=27
- Bob 14,48,70,11
- Wait 20 : Window 0 : Every Off
- End Proc
- Procedure CLA_SORT[G]
- For I=0 To 17
- A$(G)=""
- For T=0 To 29
- A$(G)=A$(G)+Chr$(W(I,T))
- Next T
- Inc G
- Next I
- Bob Off 14 : Wait Vbl
- Ink 14,12 : Text 56,80," "
- Text 302,80," "
- End Proc
- Procedure CLB_SORT[G]
- For I=0 To 17
- B$(G)=""
- For T=0 To 29
- B$(G)=B$(G)+Chr$(W(I,T))
- Next T
- Inc G
- Next I
- Bob Off 14 : Wait Vbl
- Ink 14,12 : Text 56,80," "
- Text 302,80," "
- End Proc
- Procedure INIT_ZONES
- Reserve Zone 17
- Set Zone 1,382,10 To 452,31
- Set Zone 2,464,10 To 532,31
- Set Zone 3,545,10 To 612,31
- Set Zone 4,382,39 To 452,60
- Set Zone 5,464,39 To 532,60
- Set Zone 6,545,39 To 612,60
- Set Zone 7,382,95 To 452,116
- Set Zone 8,464,95 To 532,116
- Set Zone 9,545,95 To 612,116
- Set Zone 10,382,145 To 452,166
- Set Zone 11,464,145 To 532,166
- Set Zone 12,545,145 To 612,166
- Set Zone 13,298,70 To 348,85
- Set Zone 14,50,70 To 100,85
- Set Zone 15,0,0 To 5,5
- End Proc
- Procedure YES_NON
- Clear Key : Pen 11 : Paper 13
- Locate 18,17 : Print "Please Confirm";
- Locate 17,20 : Print Border$(Zone$(" YES ",16),1)
- Locate 23,20 : Print " or ";Border$(Zone$(" NO ",17),1)
- ANS=0 : Curs Off
- While ANS=0
- While Mouse Key=0 : Wend
- Z=Mouse Zone
- If Z=16
- ANS=1
- End If
- If Z=17
- ANS=2
- End If
- Wend
- End Proc
- Procedure WP_PUTA[G]
- Curs Off
- For L=0 To 17
- Print A$(G)
- For E=0 To 29
- CODE=Asc(Mid$(A$(G),E+1,1))
- If CODE>0 Then W(L,E)=CODE Else W(L,E)=32
- Next E
- Inc G
- Next L
- End Proc
- Procedure WP_PUTB[G]
- Curs Off
- For L=0 To 17
- Print B$(G)
- For E=0 To 29
- CODE=Asc(Mid$(B$(G),E+1,1))
- If CODE>0 Then W(L,E)=CODE Else W(L,E)=32
- Next E
- Inc G
- Next L
- End Proc
- Procedure HEADING[CMN,PGE]
- Ink 14,12 : Text 56,80,"Done" : Text 302,80,"Clear"
- Ink 14,8 : Text 110,80," Column "+Str$(CMN)+" -- Page "+Str$(PGE)
- Window 1 : Clw
- End Proc
- Procedure CLEAR_HEAD
- Ink 14,12 : Text 56,80," " : Text 302,80," "
- Ink 14,8 : Text 108,80," "
- End Proc
- Procedure PAGE_PRINT[G]
- Restore DAT2
- If G=3 Then Restore DAT3
- If G=4 Then Restore DAT4
- If G=5 Then Restore DAT5
- If G=6 Then Restore DAT6
- I=12 : A$="" : While A$<>"xxx"
- Read A$
- If A$<>"xxx" Then Locate 8,I : Print A$
- Inc I : Wend
- Locate 13,29 : Print "Press any key to continue"
- Clear Key : Wait Key
- For I=29 To 12 Step -1 : Locate 8,I : Print Space$(35) : Next I
- DAT2:
- Data " Cassette Label Maker allows you to"
- Data "enter up to three pages of text."," "
- Data " Each page contains two columns of"
- Data "17 lines by 30 letters."," "
- Data " Select the page you wish to enter"
- Data "and type your list in the normal"
- Data "way. You can use the cursor keys to"
- Data "move across the page."," "
- Data " Starting a line with an asterisk"
- Data "(*) informs the printer that this"
- Data "line is to be printed in italics.","xxx"
- DAT3:
- Data " To clear a page place mouse over"
- Data "(Clear) and press mouse button."," "
- Data " When you have finished, entering"
- Data "a page, press the (Esc)ape key or"
- Data "the (Done) key.","xxx"
- DAT4:
- Data " (Titles) This command allows you"
- Data "to enter up to two cassette titles."
- Data "Two for the front-side and two for"
- Data "the back-side of the label."," "
- Data " (New) clears all the memory ready"
- Data "for a new label. Any data in memory"
- Data "will be lost."," "
- Data " Labels can be (Save)d and then"
- Data "(Load)ed back using the appropriate"
- Data "buttons.","xxx"
- DAT5:
- Data " To print your labels press the"
- Data "(Print) button. The printer"
- Data "control codes are set for an Epson"
- Data "compatable printer."," "
- Data " If you have a different printer"
- Data "and wish to change them , these are"
- Data "the required codes:-"," "
- Data "1. Normal Sized / Double Strike"
- Data " and Emphasized"
- Data "2. Compressed / Double Strike"
- Data "3. Compressed / Single Strike"
- Data "4. 10/72 inch line spacing"
- Data "5. Set Italics Mode"
- Data "6. Release Italics Mode","xxx"
- DAT6:
- Data " Control Codes must be entered"
- Data "using this format:-"," "
- Data "EXAMPLE:-"," "
- Data " The code to set an Epson printer"
- Data "to select Compressed and Double"
- Data "Strike printing is:"
- Data " Chr$(27);"+Chr$(34)+"!"+Chr$(34)+";Chr$(22)"," "
- Data " This is translated to:"
- Data " 27 33 24"," "
- Data " As can be seen the letter (!) is"
- Data "translated to 33 decimal."," "
- Data "xxx"
- End Proc
- ' ----------------------------
- Procedure LAB_LOAD
- On Error Goto HELP
- Bob 1,382,10,1
- Wait Vbl
- SPACES
- CLEAR_HEAD
- Window 1 : Clw : Curs Off
- F$=Fsel$("*.lab",""," Load a Cassette Label ")
- If F$="" Then Goto NL
- X1=80 : X2=80 : Y1=170 : Y2=180
- Ink 4,13 : For I=0 To 58 : Draw X1,Y1 To X2,Y2
- X1=X1+4 : X2=X2+4 : Next I
- Text 105,155,"Loading..... Please Wait"
- Ink 13,13 : X1=312 : X2=312
- Open In 1,F$
- For I=0 To 58
- Draw X1,Y1 To X2,Y2
- Input #1,A$(I)
- Input #1,B$(I)
- X1=X1-4 : X2=X2-4
- Next I
- Close 1
- Text 105,155," "
- NL:
- Window 0
- If F$<>""
- Pen 4 : Paper 13
- Locate 7,2 : Print A$(1) : Locate 7,3 : Print A$(2)
- Locate 7,5 : Print A$(3) : Locate 7,6 : Print A$(4)
- End If
- Bob Off 1
- Pop Proc
- HELP:
- ERR=True : Resume Next
- End Proc
- Procedure LAB_SAVE
- Bob 2,464,10,2
- Wait Vbl
- CLEAR_HEAD
- Window 1 : Clw : Curs Off
- F$=Fsel$("*.lab",""," Save a Cassette Label ")
- If F$="" Then Goto NS
- Ink 4,13 : Text 100,155,"Saving...... Please Wait"
- Open Out 1,F$
- For I=0 To 58
- Print #1,A$(I)
- Print #1,B$(I)
- Next I
- Close 1
- Text 100,155," "
- NS:
- Window 0
- Bob Off 2
- End Proc
- Procedure GO_PRINTER
- Bob 3,544,10,3
- Window 1 : Clw
- Ink 0,8 : Text 120,80," Ready for Printing "
- Window 0 : Curs Off
- YES_NON
- Window 1 : Clw : Curs Off
- If ANS=2 Then Goto PDONE
- Text 115,80," Printing "
- SEND_CODE[0]
- Lprint " ";String$("-",39)
- Lprint "|";Space$(38);" |"
- Lprint "|";Space$(38);" |"
- Lprint "| ";A$(1);" |" : Lprint "| ";A$(2);" |"
- Lprint "|";String$("-",39);"|"
- Lprint "| ";A$(3);" |" : Lprint "| ";A$(4);" |"
- Lprint "|";String$("-",39);"|"
- SEND_CODE[3]
- SEND_CODE[1]
- K=1 : FLAG=0
- For T=5 To 58
- Rem -------------
- B$=Left$(A$(T),30)
- Lprint "| ";
- Gosub CHECK_ITALICS
- Lprint B$;" ";
- Gosub ITALICS_OFF
- Rem -------------
- B$=Left$(B$(T),30)
- Gosub CHECK_ITALICS
- Lprint B$;
- Gosub ITALICS_OFF
- Lprint " |" : K=K+1
- If K=19
- Lprint "|";String$("-",68);"|"
- K=1
- End If
- Next
- PDONE:
- Text 122,80," "
- Window 0
- Bob Off 3
- Pop Proc
- CHECK_ITALICS:
- If Left$(B$,1)="*"
- SEND_CODE[2]
- SEND_CODE[4]
- FLAG=1 : B$=" "+Mid$(B$,2,29)
- End If
- Return
- ITALICS_OFF:
- If FLAG=1
- SEND_CODE[1]
- SEND_CODE[5]
- End If
- Return
- End Proc
- Procedure PCODE_SETUP
- On Error Proc PFIX
- Resume Label PFDONE
- Open In 1,"df0:s/Lab.Config"
- For I=0 To 5
- Input #1,CODE$(I)
- Next I
- Close 1
- PFDONE:
- End Proc
- Procedure PFIX
- ' ************* Setting for my printer **************
- ' ************* A Panasonic KX-P1081 **************
- ' (0)Print style 24 - (1)Print style 22 - (2)Print style 6
- ' (3)Line space 10/72 inch - (4)Set Italics on - (5)Set Itlaics off
- Restore CDS
- For I=0 To 5 : Read CODE$(I) : Next I
- CDS:
- Data "27 33 24","27 33 22","27 33 6"
- Data "27 65 10","27 52","27 53"
- Resume Label
- End Proc
- Procedure SEND_CODE[G]
- A$=CODE$(G) : A=Len(A$) : C$=""
- For T=1 To A
- B$=Mid$(A$,T,1)
- If B$<>" " Then C$=C$+B$
- If B$=" " or T=A Then Lprint Chr$(Val(C$)); : C$=""
- Next T
- End Proc
- Procedure NEW
- Bob 4,382,39,4
- Window 1 : Clw : Window 0
- YES_NON
- If ANS=2 Then Goto CON_N
- SPACES : CLEAR_HEAD : CLEAR_WP
- For T=0 To 60
- A$(T)=Space$(30) : B$(T)=Space$(30)
- Next T
- Window 2 : Clw : Window 3 : Clw
- CON_N:
- Window 1 : Clw : Window 0 : Bob Off 4
- End Proc
- Procedure SPACES
- A=60
- For T=0 To 60
- A$(T)=Space$(30) : B$(T)=Space$(30)
- Next T
- End Proc
- Procedure TITLES
- Restore DAT1
- Pen 4 : Paper 13
- Window 2 : Clw : Window 3 : Clw : Window 0
- Bob 5,460,39,5 : Curs On
- For T=1 To 2
- Read F
- ENTER_LINE[7,F,36]
- MIDDLE[7,F,36] : A$(T)=A$
- MIDDLE[7,F+3,36] : A$(T+2)=A$
- Next T
- DAT1:
- Data 2,3
- Curs Off : Bob Off 5
- End Proc
- Procedure HELP
- Bob 6,544,39,6
- CLEAR_HEAD
- Ink 14,8 : Text 108,80," Help"
- Window 1 : Clw : Window 0 : Pen 4 : Paper 13
- PAGE_PRINT[2] : PAGE_PRINT[3]
- PAGE_PRINT[4] : PAGE_PRINT[5]
- Locate 15,13 : Print "Do you wish to change"
- Locate 15,15 : Print " the printer codes ?"
- YES_NON
- Window 1 : Clw : If ANS=2 Then Goto NON
- Window 0 : PAGE_PRINT[6] : Window 1 : Clw
- CHGE=False
- For I=0 To 5
- Ink 4,13
- Text 85,120," The current setting for this"
- Text 85,130," codes is "+CODE$(I) : QW$=CODE$(I)
- Read Q$ : Text 85,170,"Enter new code to select"
- Ink 6,13 : Text 85,146,String$("-",28) : Ink 0
- Text 85,185,Q$ : Read Q$ : Text 85,193,Q$
- Locate 0,14 : Input CODE$(I)
- If CODE$(I)=""
- CODE$(I)=QW$
- Else
- CHGE=True
- End If
- Clw
- Next I
- If CHGE=False Then Goto NON
- Open Out 1,"df0:s/Lab.Config"
- For I=0 To 5
- Print #1,CODE$(I)
- Next I
- Close 1
- Clw : Window 0
- NON:
- Curs Off : Ink 14,8 : Text 108,80," "
- Bob Off 6
- Data "Normal Sized/Double Strike","Emphasized printing"
- Data "Size Compressed/Double Strike","printing"
- Data "Size Compressed/Single Strike","printing"
- Data " 10/72 inch line spacing"," "
- Data " Set Italics Mode"," "
- Data " Release Italics Mode"," "
- End Proc
- Procedure P11
- Bob 7,382,95,7
- HEADING[1,1] : WP_PUTA[5]
- ENTER_LIST : CLA_SORT[5] : Curs Off
- Bob Off 7
- End Proc
- Procedure P12
- Bob 8,462,95,8
- HEADING[1,2] : WP_PUTA[23]
- ENTER_LIST : CLA_SORT[23] : Curs Off
- Bob Off 8
- End Proc
- Procedure P13
- Bob 9,543,95,9
- HEADING[1,3] : WP_PUTA[41]
- ENTER_LIST : CLA_SORT[41] : Curs Off
- Bob Off 9
- End Proc
- Procedure P21
- Bob 10,382,145,7
- HEADING[2,1] : WP_PUTB[5]
- ENTER_LIST : CLB_SORT[5] : Curs Off
- Bob Off 10
- End Proc
- Procedure P22
- Bob 11,464,145,8
- HEADING[2,2] : WP_PUTB[23]
- ENTER_LIST : CLB_SORT[23] : Curs Off
- Bob Off 11
- End Proc
- Procedure P23
- Bob 12,544,145,9
- HEADING[2,3] : WP_PUTB[41]
- ENTER_LIST : CLB_SORT[41] : Curs Off
- Bob Off 12
- End Proc