1: DECLARE SUB FourBit () 2: DECLARE SUB EightBit () 3: '============================================================================= 4: ' BMP VIEWER 5: ' by 6: ' Sam Westbrook 7: ' Display RGB Encoded Bitmaps 8: ' 16 Color: 640 X 480 9: ' 256 Color: 320 X 200 10: '----------------------------------------------------------------------------- 11: ' Beta Version 12: ' Released September 30, 1995 13: '============================================================================= 14: DIM ZBaseSize AS STRING * 1 15: DIM YBaseSize AS STRING * 1 16: DIM ZExSize AS STRING * 1 17: DIM YExSize AS STRING * 1 18: DIM PicType AS STRING * 1 19: DIM PalArray&(16) 20: DIM Title(1 TO 10000) 21: DIM SHARED ZSize AS INTEGER 22: DIM SHARED YSize AS INTEGER 23: CLS 24: SCREEN 12 25: PalArray&(0) = 65536 * 0 + 256 * 0 + 0 26: PalArray&(1) = 65536 * 0 + 256 * 0 + 16 27: PalArray&(2) = 65536 * 0 + 256 * 16 + 0 28: PalArray&(3) = 65536 * 0 + 256 * 16 + 16 29: PalArray&(4) = 65536 * 16 + 256 * 0 + 0 30: PalArray&(5) = 65536 * 16 + 256 * 0 + 16 31: PalArray&(6) = 65536 * 16 + 256 * 16 + 0 32: PalArray&(7) = 65536 * 24 + 256 * 24 + 24 33: PalArray&(8) = 65536 * 16 + 256 * 16 + 16 34: PalArray&(9) = 65536 * 0 + 256 * 0 + 32 35: PalArray&(10) = 65536 * 0 + 256 * 32 + 0 36: PalArray&(11) = 65536 * 0 + 256 * 32 + 32 37: PalArray&(12) = 65536 * 32 + 256 * 0 + 0 38: PalArray&(13) = 65536 * 32 + 256 * 0 + 32 39: PalArray&(14) = 65536 * 32 + 256 * 32 + 0 40: PalArray&(15) = 65536 * 32 + 256 * 32 + 32 41: PALETTE USING PalArray&(0) 42: DEF SEG = VARSEG(Title(1)) 43: 44: '** Enter the correct path here: 45: 46: BLOAD "C:\AOL20\DOWNLOAD\TITLE.PIC", VARPTR(Title(1)) 47: DEF SEG 48: PUT (165, 125), Title 49: DO: LOOP UNTIL INKEY$ <> "" 50: 51: PALETTE 52: SCREEN 0 53: 54: '** For Visual Basic users, you might want to put the ON ERROR RESUME NEXT 55: '** statement here. 56: 57: LINE INPUT "Enter directory to search for BMP files: "; Dcry$ 58: CLS 59: IF RIGHT$(Dcry$, 1) = "\" THEN Dcry$ = Dcry$ ELSE Dcry$ = Dcry$ + "\" 60: Dry$ = Dcry$ + "*.bmp" 61: FILES Dry$ 62: PRINT 63: LINE INPUT "Enter a file to view: "; File$ 64: Extntn$ = RIGHT$(File$, 4) 65: Extntn$ = UCASE$(Extntn$) 66: IF Extntn$ <> ".BMP" THEN File$ = File$ + ".BMP" 67: File$ = UCASE$(File$) 68: File$ = Dcry$ + File$ 69: OPEN File$ FOR BINARY ACCESS READ AS #1 70: GET #1, 19, ZBaseSize 71: GET #1, 20, ZExSize 72: GET #1, 23, YBaseSize 73: GET #1, 24, YExSize 74: GET #1, 29, PicType 75: ZSize = ASC(ZBaseSize) + (256 * ASC(ZExSize)) 76: YSize = ASC(YBaseSize) + (256 * ASC(YExSize)) 77: BitType = ASC(PicType) 78: IF BitType = 4 THEN PicColors% = 16 79: IF BitType = 8 THEN PicColors% = 256 80: 81: CLS 82: PRINT "XDimension: "; ZSize 83: PRINT "YDimension: "; YSize 84: PRINT "Resolution: "; ZSize; "X"; YSize 85: PRINT "Graphic Bits: "; BitType 86: PRINT "Max. Colors: "; PicColors% 87: PRINT 88: PRINT "Press any key to view " + File$ 89: 90: DO: LOOP UNTIL INKEY$ <> "" 91: 92: IF BitType = 4 THEN CALL FourBit 93: IF BitType = 8 THEN CALL EightBit: ELSE LOCATE 9, 1: PRINT "Invalid Bitmap" 94: END 95: 96: SUB EightBit 97: DIM HexCode AS STRING * 1 98: DIM PalArray&(256) 99: DIM Red AS STRING * 1 100: DIM Green AS STRING * 1 101: DIM Blue AS STRING * 1 102: 103: CLS 104: SCREEN 13 105: 106: FOR i% = 1 TO 256 107: GET #1, 55 + (i% * 4), Red 108: GET #1, 55 + (i% * 4) + 1, Green 109: GET #1, 55 + (i% * 4) + 2, Blue 110: CCHex1% = INT(ASC(Red)) / 8 111: CCHex2% = INT(ASC(Green)) / 8 112: CCHex3% = INT(ASC(Blue)) / 8 113: PalArray&(i%) = 65536 * CCHex1% + 256 * CCHex2% + CCHex3% 114: NEXT i% 115: 116: PALETTE USING PalArray&(0) 117: 118: '** I haven't yet developed a routine to detect where to start plotting 119: '** pixels for 256 color bitmaps. If the picture isn't alligned right, 120: '** adjust the X variable to straighten it. The value 1079 is the 121: '** correct alignment for DMDEMO.BMP. 122: 123: X = 1079 124: Z = ZSize 125: Y = YSize 126: 127: DO 128: IF Z >= ZSize THEN Y = Y - 1 129: IF Z >= ZSize THEN Z = 0 130: X = X + 1 131: Z = Z + 1 132: GET #1, X, HexCode 133: CC1% = ASC(HexCode) 134: PSET (Z, Y), CC1% 135: LOOP UNTIL Y = 0 AND Z = ZSize 136: CLOSE #1 137: 138: DO: LOOP UNTIL INKEY$ <> "" 139: END 140: END SUB 141: 142: SUB FourBit 143: DIM HexCode AS STRING * 1 144: DIM Hex1 AS STRING * 1 145: DIM Hex2 AS STRING * 1 146: DIM PalArray&(16) 147: DIM Red AS STRING * 1 148: DIM Green AS STRING * 1 149: DIM Blue AS STRING * 1 150: 151: CLS 152: SCREEN 12 153: 154: FOR i% = 1 TO 16 155: GET #1, 55 + (i% * 4), Red 156: GET #1, 55 + (i% * 4) + 1, Green 157: GET #1, 55 + (i% * 4) + 2, Blue 158: CCHex1% = INT(ASC(Red)) / 8 159: CCHex2% = INT(ASC(Green)) / 8 160: CCHex3% = INT(ASC(Blue)) / 8 161: PalArray&(i%) = 65536 * CCHex1% + 256 * CCHex2% + CCHex3% 162: NEXT i% 163: 164: PALETTE USING PalArray&(0) 165: 166: X = 118 167: Z = ZSize 168: Y = YSize 169: 170: DO 171: IF Z >= ZSize THEN Y = Y - 1 172: IF Z >= ZSize THEN Z = 0 173: X = X + 1 174: Z = Z + 1 175: GET #1, X, HexCode 176: Hex1 = LEFT$(HEX$(ASC(HexCode)), 1) 177: Hex2 = RIGHT$(HEX$(ASC(HexCode)), 1) 178: CC1% = VAL(Hex1) 179: CC2% = VAL(Hex2) 180: IF Hex1 = "A" THEN CC1% = 10 181: IF Hex1 = "B" THEN CC1% = 11 182: IF Hex1 = "C" THEN CC1% = 12 183: IF Hex1 = "D" THEN CC1% = 13 184: IF Hex1 = "E" THEN CC1% = 14 185: IF Hex1 = "F" THEN CC1% = 15 186: IF Hex2 = "A" THEN CC2% = 10 187: IF Hex2 = "B" THEN CC2% = 11 188: IF Hex2 = "C" THEN CC2% = 12 189: IF Hex2 = "D" THEN CC2% = 13 190: IF Hex2 = "E" THEN CC2% = 14 191: IF Hex2 = "F" THEN CC2% = 15 192: PSET (Z, Y), CC1%: Z = Z + 1 193: PSET (Z, Y), CC2% 194: LOOP UNTIL Y = 0 AND Z = ZSize 195: CLOSE #1 196: 197: DO: LOOP UNTIL INKEY$ <> "" 198: END 199: END SUB 200: |