8-Bit Software Online Conversion
Letterhead Designer - Listing
10REM Letter Head Designer
20REM Version 1.10
30REM By Piers Wilson
40REM Watch out for version 2.00 ...
50REM ... Coming soon !
60:
70MODE4
80*FX229,1
90VDU19,0,4;0;19,1,7;0;23,1,0;0;0;0;
100PROCinit
110PRINTTAB(0,6);STRING$(40,CHR$224)
120VDU5:MOVE0,31:PRINTSTRING$(40,CHR$2
24):MOVE0,0:VDU4
130REPEAT
140 M%=FNmenu
150 IF M%=6 IF FNask("Are you sure (Y/
N)","Y","N")=1 THEN PROCwindow(1):END
160 IF M%=1 PROCprint ELSE IF M%=2 PRO
Cdesign ELSE IF M%=3 PROCsave ELSE IF M%
=4 PROCload ELSE IF M%=5 PROCclear
170UNTIL 0
180:
190DEFPROCinit
200VDU23,224,0,0,255,&AA,&55,255,0,0
210VDU23,225,0,96,96,0,0,0,0,0
220VDU23,226,240,144,144,240,0,0,0,0
230VDU23,227,128,128,128,128,128,128,1
28,128
240VDU23,228,1,1,1,1,1,1,1,1
250VDU23,229,8,28,62,127,8,8,8,0
260ENDPROC
270:
280DEFPROCwindow(fc%)
290VDU28,0,30,39,7
300IF fc%=0 THEN bc%=1 ELSE fc%=1:bc%=
0
310COLOUR128+bc%:COLOURfc%:CLS
320ENDPROC
330:
340DEFPROCdouble(A$,xpos%,ypos%)
350FORI%=1 TO LENA$
360A%=&A:X%=&70:Y%=&00
370?&70=ASC(MID$(A$,I%,1))
380CALL &FFF1
390VDU23,254,?&71,?&71,?&72,?&72,?&73,
?&73,?&74,?&74
400VDU23,255,?&75,?&75,?&76,?&76,?&77,
?&77,?&78,?&78
410PRINTTAB(xpos%+I%,ypos%)" "
420PRINTTAB(xpos%+I%,ypos%+1)CHR$254
430PRINTTAB(xpos%+I%,ypos%+2)CHR$255
440PRINTTAB(xpos%+I%,ypos%+3)" "
450NEXT
460ENDPROC
470:
480DEFFNmenu
490PROCwindow(0)
500COLOUR128:COLOUR1
510PROCdouble(" Letterhead Designer Me
nu ",6,1)
520COLOUR129:COLOUR0
530PRINTTAB(6,6)" 1..... Print Letterh
ead "TAB(6,8)" 2..... Edit Letterhead "T
AB(6,10)" 3..... Save Letterhead "
540PRINTTAB(6,12)" 4..... Load Letterh
ead "TAB(6,14)" 5..... Clear Letterhead"
TAB(6,16)" 6..... End the Program"
550COLOUR128:COLOUR1
560PROCdouble(" Enter your choice (1-6
). ",6,19)
570REPEAT
580*FX15,1
590A=GET-48
600UNTIL A>0 AND A<7
610=A
620:
630DEFPROCzoom(left%)
640VDU5
650FOR row%=0 TO 191 STEP 4
660FOR col%=left% TO left%+320 STEP 4
670GCOL 0,POINT(col%,835+row%)
680MOVE (col%-left%)*4,47+(row%*4)
690VDU225
700GCOL3,1:PLOT69,col%,831+row%:PLOT69
,col%,831+row%
710NEXT
720NEXT
730VDU4
740ENDPROC
750:
760DEFPROCedit(orig%)
770GCOL4,1
780MOVE 0,799:VDU5,226,4
790a%=0:b%=799:aa%=orig%:bb%=1023
800REPEAT
810MOVE a%,b%:VDU5,226,4
820IF INKEY-98 AND a%>0 a%=a%-16:aa%=a
a%-4
830IF INKEY-67 AND a%<1263 a%=a%+16:aa
%=aa%+4
840IF INKEY-73 AND b%<799 b%=b%+16:bb%
=bb%+4
850IF INKEY-105 AND b%>47 b%=b%-16:bb%
=bb%-4
860MOVE a%,b%:VDU5,226,4
870IF INKEY-74 GCOL0,1:MOVE a%,b%:VDU5
,225,4:PLOT69,aa%,bb%
880IF INKEY-90 GCOL0,0:MOVE a%,b%:VDU5
,225,4:PLOT69,aa%,bb%
890GCOL4,1
900MOVE a%,b%:VDU5,226,4
910MOVE a%,b%:VDU5,226,4
920UNTIL INKEY-113
930ENDPROC
940:
950DEFFNask(Q$,A1$,A2$)
960PROCwindow(0)
970PROCdouble(Q$,(40-LENQ$)/2-1,8)
980*FX15,1
990REPEAT
1000*FX15,1
1010B$=GET$
1020*FX15,1
1030IF B$=A1$ THEN ans%=1 ELSE IF B$=A2
$ ans%=2 ELSE ans%=0
1040UNTIL ans%<>0
1050=ans%
1060:
1070DEFFNcur
1080VDU26
1090cur%=0
1100REPEAT
1110cur%=cur%+(INKEY-98 AND cur%>0)-(IN
KEY-67 AND cur%<30)
1120IF cur%=30 cur$=STRING$(30,CHR$224)
+A$:GOTO 1150
1130IF cur%=0 cur$=A$+STRING$(30,CHR$22
4):GOTO 1150
1140cur$=STRING$(cur%,CHR$224)+A$+STRIN
G$(40-cur%-10,CHR$224)
1150PRINTTAB(0,6)cur$
1160UNTIL INKEY-74
1170=cur%
1180:
1190DEFPROCdesign
1200A$=CHR$227+STRING$(8," ")+CHR$228
1210CLS
1220PROCwindow(1):PROCdouble("Select ar
ea to edit ...",7,8)
1230st%=FNcur
1240PROCwindow(1)
1250VDU26:COLOUR1:COLOUR128:PRINTTAB(st
%+1,6)"Thinking"
1260PROCzoom(st%*32)
1270GCOL0,1:VDU5:MOVE0,31:PRINTSTRING$(
40,CHR$224):MOVE0,0:VDU4
1280VDU26:COLOUR1:COLOUR128:PRINTTAB(st
%+1,6)"Editing";CHR$229
1290PROCedit(st%*32)
1300VDU26:COLOUR1:COLOUR128:PRINTTAB(st
%+1,6)" "
1310ENDPROC
1320:
1330DEFPROCsave
1340PROCwindow(0)
1350PROCdouble("Enter Filename :",6,8)
1360INPUTTAB(8,12)">"file$:file$=LEFT$(
file$,10)
1370PROCwindow(1)
1380OSCLI"SAVE L."+LEFT$(file$,7)+" 580
0 5F80"
1390PROCwindow(1):PROCdouble("Letter he
ad saved",6,2)
1400PROCdouble("PRESS A KEY ...",8,8)
1410A=GET
1420ENDPROC
1430:
1440DEFPROCload
1450PROCwindow(0)
1460PROCdouble("Enter Filename :",6,8)
1470INPUTTAB(8,12)">"file$:file$=LEFT$(
file$,10)
1480PROCwindow(1)
1490OSCLI"LOAD L."+LEFT$(file$,7)+" 580
0"
1500ENDPROC
1510:
1520DEFPROCprint
1530line%=(FNask("Underline Letterhead
(Y/N)","Y","N")=1)
1540PROCwindow(0)
1550COLOUR128:COLOUR1
1560PROCdouble("Press ""P"" to print",9
,8)
1570REPEAT UNTIL (GET AND &DF)=80
1580PROCdouble(" Printing ... ",9,8
)
1590VDU2,1,10,1,10,1,10,1,27,1,65,1,8,3
1600FORy%=1023 TO 847 STEP -16
1610VDU2,1,27,1,90,1,128,1,7
1620FORx%=0 TO 1279 STEP 4
1630byte%=0
1640FORi%=7 TO 0 STEP -1
1650byte%=byte%+(POINT(x%,y%-((7-i%)*2)
)*2^i%)
1660NEXT
1670FORprint%=1 TO 6:VDU1,byte%:NEXT
1680NEXT x%
1690NEXT y%
1700VDU1,10,1,10,1,10
1710IF line% THEN PROCunder
1720VDU1,7,1,7,1,10,1,10
1730VDU3
1740ENDPROC
1750:
1760DEFPROCunder
1770VDU2,1,27,1,90,1,128,1,7:FOR under%
=1 TO 100:VDU1,0:NEXT:FOR under%=100 TO
110:VDU1,16:NEXT:FOR under%=110 TO 1810:
VDU1,18:NEXT:FOR under%=1810 TO 1820:VDU
1,16:NEXT:FOR under%=1820 TO 1920:VDU1,0
:NEXT
1780ENDPROC
1790:
1800DEFPROCclear
1810VDU28,0,5,39,0:COLOUR128:CLS:ENDPRO
C