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