DEFINT A-Z DECLARE SUB FourBIT (x1%, y1%, x2%, y2%, Filename$) DECLARE SUB Border (clr%) 'ASCII Code set....used with the INKEY$ to find out what kind of information ' is entered and can filter for CAPS (65 to 90) or lowcase (97 to 122) ON ERROR GOTO Handler SCREEN 12 CLS COLOR 14 LOCATE 2, 4: PRINT " ASCII and IBM Character Code set using CHR$(n%)" PRINT STRING$(80, CHR$(223)) COLOR 12 FOR i% = 1 TO 6 PRINT i%; CHR$(i%); " "; NEXT i% PRINT 7; " "; FOR i% = 14 TO 16 PRINT i%; CHR$(i%); " "; NEXT PRINT 17; CHR$(17); " "; PRINT 18; CHR$(18); " "; PRINT 19; CHR$(19); " "; PRINT 20; CHR$(20); " "; PRINT 21; CHR$(21); " "; PRINT 22; CHR$(22); " "; PRINT 23; CHR$(23); " "; PRINT 24; CHR$(24); " "; PRINT 25; CHR$(25); " "; PRINT 26; CHR$(26); " "; PRINT 27; CHR$(27); " "; FOR i% = 33 TO 255 COLOR 10 IF i% > 47 AND i% < 58 THEN COLOR 9 'denotes number keys 48 to 57 IF i% > 175 AND i% < 224 THEN COLOR 11 'drawing characters 176 to 223 IF i% > 64 AND i% < 91 THEN COLOR 13 ' A to Z keys 65 to 90 IF i% > 96 AND i% < 123 THEN COLOR 15 'a to z keys 97 to 122 IF i% > 91 AND i% < 100 THEN PRINT " "; IF i% = 100 THEN PRINT " "; PRINT i%; CHR$(i%); " "; NEXT i% COLOR 14: PRINT STRING$(80, CHR$(220)) Border 14 COLOR 12: LOCATE 26, 4: PRINT " 7) BEEP, 8) Backspace, 9) Tab, 10) LineFeed(printer)" LOCATE 27, 4: PRINT " 12) FormFeed(printer), 13) Return, 26) End of file" LOCATE 28, 4: PRINT " 27) Escape 30) Line up, 31) Line down, 32) Spacebar" OPEN "ASCII.BMP" FOR INPUT AS #2 CLOSE #2 IF FileErr = 1 THEN COLOR 10: LOCATE 29, 27: PRINT "Wait! Creating ASCII.BMP"; FourBIT 0, 0, 639, 479, "ASCII.BMP" FileErr = 0 END IF Handler: FileErr = 1 RESUME NEXT COLOR 13: LOCATE 29, 27: PRINT " Hit any key to continue! "; DO: LOOP UNTIL INKEY$ <> "" SYSTEM SUB Border (clr) COLOR clr FOR Row = 1 TO 30 LOCATE Row, 1: PRINT CHR$(179); LOCATE Row, 80: PRINT CHR$(179); NEXT Row FOR Col = 1 TO 80 LOCATE 1, Col: PRINT CHR$(196); LOCATE 30, Col: PRINT CHR$(196); NEXT Col LOCATE 1, 1: PRINT CHR$(218); LOCATE 1, 80: PRINT CHR$(191); LOCATE 30, 1: PRINT CHR$(192); LOCATE 30, 80: PRINT CHR$(217); END SUB SUB FourBIT (x1%, y1%, x2%, y2%, Filename$) 'SCREEN 12 bitmap maker by TheBob DIM FileCOLORS%(1 TO 48) DIM Colors4%(0 TO 15) IF INSTR(Filename$, ".BMP") = 0 THEN Filename$ = RTRIM$(LEFT$(Filename$, 8)) + ".BMP" END IF FileTYPE$ = "BM" Reserved1% = 0 Reserved2% = 0 OffsetBITS& = 118 InfoHEADER& = 40 PictureWIDTH& = x2% - x1% + 1 PictureDEPTH& = y2% - y1% + 1 NumPLANES% = 1 BPP% = 4 Compression& = 0 WidthPELS& = 3780 DepthPELS& = 3780 NumCOLORS& = 16 IF PictureWIDTH& MOD 8 <> 0 THEN ZeroPAD$ = SPACE$((8 - PictureWIDTH& MOD 8) \ 2) END IF ImageSIZE& = (((PictureWIDTH& + LEN(ZeroPAD$)) * PictureDEPTH&) + .1) / 2 FileSize& = ImageSIZE& + OffsetBITS& Colr = 0 'start at color 0 FOR n = 1 TO 48 STEP 3 OUT &H3C7, Colr FileCOLORS%(n) = INP(&H3C9) FileCOLORS%(n + 1) = INP(&H3C9) FileCOLORS%(n + 2) = INP(&H3C9) Colr = Colr + 1 NEXT n OPEN Filename$ FOR BINARY AS #1 'Header bytes PUT #1, , FileTYPE$ '2 PUT #1, , FileSize& '4 PUT #1, , Reserved1% 'should be zero '2 PUT #1, , Reserved2% 'should be zero '2 PUT #1, , OffsetBITS& '4 PUT #1, , InfoHEADER& '4 PUT #1, , PictureWIDTH& '4 PUT #1, , PictureDEPTH& '4 PUT #1, , NumPLANES% '2 PUT #1, , BPP% '2 PUT #1, , Compression& '4 PUT #1, , ImageSIZE& '4 PUT #1, , WidthPELS& '4 PUT #1, , DepthPELS& '4 PUT #1, , NumCOLORS& '4 PUT #1, , SigCOLORS& '4 '51 - 54 u$ = " " 'add unused byte FOR n% = 1 TO 46 STEP 3 Colr$ = CHR$(FileCOLORS%(n% + 2) * 4) PUT #1, , Colr$ Colr$ = CHR$(FileCOLORS%(n% + 1) * 4) PUT #1, , Colr$ Colr$ = CHR$(FileCOLORS%(n%) * 4) PUT #1, , Colr$ PUT #1, , u$ 'Unused byte NEXT n% FOR y = y2% TO y1% STEP -1 FOR x = x1% TO x2% STEP 2 HiX = POINT(x, y): Colors4%(HiX) = 1 'added here LoX = POINT(x + 1, y): Colors4%(LoX) = 1 HiNIBBLE$ = HEX$(HiX) LoNIBBLE$ = HEX$(LoX) HexVAL$ = "&H" + HiNIBBLE$ + LoNIBBLE$ a$ = CHR$(VAL(HexVAL$)) PUT #1, , a$ NEXT x PUT #1, , ZeroPAD$ NEXT y FOR n = 0 TO 15 IF Colors4%(n) = 1 THEN SigCOLORS& = SigCOLORS& + 1 NEXT n PUT #1, 51, SigCOLORS& 'new PUT CLOSE #1 BEEP END SUB
|
