主题:DOS下的qbasic写的读BMP文件程序
16和256色的BMP图(现在高版本的bmp已经不行了:|),写得很糟糕,但是不想改了,毕竟是自己的发展历程,代表了自己当时的水平。
顺便给一张图做测试
[img]http://www.wodutom.com/coolwindows/VIEW_01.BMP[/img]
main:
DEFINT A, I-J, T', X-Y
DIM dy AS INTEGER, colo AS INTEGER, size AS LONG, tmp AS INTEGER
DIM co0 AS INTEGER, co1 AS INTEGER, wite1 AS INTEGER, high AS INTEGER
DO
SCREEN 0: CLS
GOSUB First
INPUT "All file name(*.bmp):", filename$
IF filename$ = "" THEN EXIT DO
GOSUB OpenFile
IF of = 0 THEN CLOSE : rerr = 1: GOSUB ErrorInfo: GOTO main
GOSUB CheckBmp
IF check = 0 THEN CLOSE : rerr = 2: GOSUB ErrorInfo: GOTO main
GOSUB ReadBit
GOSUB ReadColor
IF colo = 0 THEN CLOSE : rerr = 3: GOSUB ErrorInfo: GOTO main
GOSUB ReadWH
IF w = 0 THEN CLOSE : rerr = 4: GOSUB ErrorInfo: GOTO main
IF h = 0 THEN CLOSE : rerr = 5: GOSUB ErrorInfo: GOTO main
GOSUB zip
IF zip = 1 THEN CLOSE : rerr = 6: GOSUB ErrorInfo: GOTO main
GOSUB ReadPalette
IF bit = 8 THEN SCREEN 13 ELSE SCREEN 12
GOSUB SetPalette
GOSUB ViewPicture
GOSUB AscKey
lop:
GOSUB Last
LOOP
CLS
END
First:
DIM pixel(8) AS INTEGER: x = 0: y = 1
filename$ = ""
of = 0: check = 0: colo = 0: wite = 0: high = 0: done = 0: change = 0
xb = 1: yb = 1: full = 0
OUT &H3C6, 255
RANDOMIZE TIMER
'FILES "*.bmp"
RETURN
Last:
ERASE pixel
CLOSE #1
SCREEN 12
typ = 0
CLS
RETURN
OpenFile: '(filename$|of)
IF filename$ = "h" OR filename$ = "H" THEN GOTO Help
a$ = RIGHT$(filename$, 1)
n = LEN(filename$)
ture = 1: pot = 0: pat = 0
FOR i = 1 TO n
a$ = RIGHT$(LEFT$(filename$, i), 1)
IF a$ = "*" OR a$ = "+" OR a$ = "=" OR a$ = "<" OR a$ = ">" OR a$ = "[" OR a$ = "]" OR a$ = ";" OR a$ = CHR$(34) OR a$ = "?" OR a$ = "|" THEN ture = 0: EXIT FOR
IF a$ = "/" AND i <> n THEN ture = 0
IF a$ = "." AND i = 1 THEN ture = 0
IF a$ = "." THEN pot = pot + 1
NEXT
IF pot > 1 THEN ture = 0
IF ture = 0 THEN rerr = 7: GOSUB ErrorInfo: GOTO main
IF a$ = "/" THEN filename$ = LEFT$(filename$, LEN(filename$) - 1): full = 1
OPEN filename$ FOR RANDOM AS #1
CLOSE
OPEN filename$ FOR INPUT AS #1
IF EOF(1) THEN of = 0: CLOSE : KILL filename$: ELSE of = 1
RETURN
CheckBmp: '(|check)
SEEK #1, 1
IF INPUT$(2, 1) = "BM" THEN check = 1 ELSE check = 0
RETURN
ReadColor: '(|colo,typ)
SEEK #1, &H2F
colo = ASC(INPUT$(1, 1))
IF colo = 0 THEN IF bit = 8 THEN colo = 256 ELSE colo = 16
IF colo <= 16 THEN typ = 1 ELSE IF colo > 256 THEN colo = 0
RETURN
ReadWH: '(|wite,high)
DIM temp(8)
i = &H13
FOR j = 1 TO 8
SEEK #1, i
temp(j) = ASC(INPUT$(1, 1))
i = i + 1
NEXT
SEEK #1, &H23
a$ = INPUT$(3, 1)
size = ASC(LEFT$(a$, 1)) / 16 + ASC(RIGHT$(LEFT$(a$, 2), 1)) * 16 + ASC(RIGHT$(a$, 1)) * 4096
wite1 = temp(2) * 256 + temp(1)
high = (temp(6) * 256 + temp(5))
wite = CINT((size / high) * (8 / bit) * 16)
IF wite = 0 THEN wite = wite1
IF full = 1 THEN
IF bit < 8 THEN xb = 640 / wite1: yb = 480 / high ELSE xb = 320 / wite1: yb = 200 / high
END IF
high = high * yb
IF full = 0 THEN
IF typ = 1 THEN
IF wite1 * wb > 640 AND wite1 > 640 THEN w = 0 ELSE w = 1
IF high > 480 THEN h = 0 ELSE h = 1
ELSE
IF wite1 * wb > 320 AND wite1 > 320 THEN w = 0 ELSE w = 1
IF high > 200 THEN h = 0 ELSE h = 1
END IF
ELSE
w = 1: h = 1
END IF
dy = high - 1
ERASE temp
RETURN
zip: '(|zip)
DIM a(4): zip = 0
i = &H1F
FOR j = 1 TO 4
SEEK #1, i
a(j) = ASC(INPUT$(1, 1))
IF a(j) <> 0 THEN zip = 1: EXIT FOR
i = i + 1
NEXT
ERASE a
RETURN
ReadPalette: '(colo|pal(dat))
dat = colo * 4
DIM pal(dat) AS INTEGER
i = &H37
SEEK #1, i
FOR j = 1 TO dat
IF EOF(1) THEN
i = i + 1
SEEK #1, i
pal(j) = INT(26 / 4)
ELSE
pal(j) = INT(ASC(INPUT$(1, 1)) / 4)
i = i + 1
END IF
NEXT
RETURN
SetPalette: '(pal(dat))
IF done = 0 THEN
IF typ = 1 THEN
IF colo < 15 THEN PALETTE 15, 0: LINE (0, 0)-(639, 479), 15, BF
ELSE
IF colo < 255 THEN PALETTE 255, 0: LINE (0, 0)-(319, 199), 255, BF
END IF
cotmp = POINT(0, 0): LOCATE 1, 1: PRINT "Setting..."
END IF
OUT &H3C8, 0
IF change = 0 THEN
FOR i = 1 TO dat STEP 4
OUT &H3C9, pal(i + 2)
OUT &H3C9, pal(i + 1)
OUT &H3C9, pal(i)
IF INP(&H60) = 1 THEN ERASE pal: GOTO lop
NEXT
ELSE
FOR i = 1 TO dat STEP 4
OUT &H3C9, 63 - pal(i + 2)
OUT &H3C9, 63 - pal(i + 1)
OUT &H3C9, 63 - pal(i)
IF INP(&H60) = 1 THEN ERASE pal: GOTO lop
NEXT
END IF
IF done = 0 THEN LINE (0, 0)-(79, 15), cotmp, BF
RETURN
ReadBit: '(|bit)
SEEK #1, &H1D
bit = ASC(INPUT$(1, 1))
RETURN
ViewPicture: '(colo,bit)
SEEK #1, &HB
a$ = INPUT$(2, 1)
record = ASC(RIGHT$(a$, 1)) * 256 + ASC(LEFT$(a$, 1)) + 1
SEEK #1, record
FOR time = 1 TO 5000
DO
IF EOF(1) THEN EXIT DO
temp = ASC(INPUT$(1, 1))
GOSUB Dec2Bin
record = record + 1
IF INP(&H60) = 1 THEN GOTO lop
LOOP
IF dy < 0 THEN EXIT FOR
record = record + 1
SEEK #1, record
temp = 26
GOSUB Dec2Bin
NEXT
xd = 1: yd = 1: a$ = "OK!": GOSUB PutCh
RETURN
Dec2Bin: '(colo,temp)
IF x >= wite THEN y = y + yb: x = 0: dy = CINT(high - y)
IF bit < 8 THEN
FOR i = 1 TO 8
pixel(i) = INT(temp / (2 ^ (8 - i))): temp = temp MOD (2 ^ (8 - i))
NEXT
IF bit = 1 THEN
IF xb <= 1 THEN
IF yb > 1 THEN FOR tmp = 0 TO 7: LINE (x * xb + tmp, dy - yb)-(x * xb + tmp, dy), pixel(tmp + 1), BF: NEXT ELSE FOR tmp = 0 TO 7: PSET (x * xb + tmp, dy), pixel(tmp + 1): NEXT
ELSE
a = 0: t = 1
FOR temp1 = 1 TO 8
FOR temp = a TO t * CINT(xb) - 1
LINE (x * xb + temp, dy - yb)-(x * xb + temp + 1, dy), pixel(temp1), BF
NEXT
a = t * CINT(xb): t = t + 1
NEXT
END IF
x = x + 8
ELSE
co0 = pixel(1) * 8 + pixel(2) * 4 + pixel(3) * 2 + pixel(4)
co1 = pixel(5) * 8 + pixel(6) * 4 + pixel(7) * 2 + pixel(8)
IF xb <= 1 THEN
IF yb > 1 THEN
LINE (x * xb, dy - yb)-(x * xb, dy), co0, BF: LINE (x * xb + 1, dy - yb)-(x * xb + 1, dy), co1, BF
ELSE
PSET (x * xb, dy), co0: PSET (x * xb + 1, dy), co1
END IF
ELSE
FOR temp = 0 TO CINT(xb) - 1
LINE (x * xb + temp, dy - yb)-(x * xb + temp + 1, dy), co0, BF
NEXT
FOR temp = CINT(xb) TO 2 * (CINT(xb)) - 1
LINE (x * xb + temp, dy - yb)-(x * xb + temp + 1, dy), co1, BF
NEXT
END IF
x = x + 2
END IF
ELSE
IF x < wite1 THEN
IF xb <= 1 THEN
IF yb > 1 THEN
LINE (x * xb, dy - yb)-(x * xb, dy), temp, BF
ELSE
PSET (x * xb, dy), temp
END IF
ELSE
FOR tmp = 0 TO CINT(xb) - 1
LINE (x * xb + tmp, dy - yb)-(x * xb + tmp + 1, dy), temp, BF
NEXT
END IF
END IF
x = x + 1
END IF
RETURN
AscKey:
DO: i$ = INKEY$
IF i$ <> "" THEN
SELECT CASE i$
CASE "c"
OUT &H3C8, 0
FOR i = 1 TO colo
OUT &H3C9, INT(RND * 64)
OUT &H3C9, INT(RND * 64)
OUT &H3C9, INT(RND * 64)
NEXT
'xd = 1: yd = 1: a$ = "OK!": GOSUB PutCh
CASE "r"
done = 1: change = 0
GOSUB SetPalette
'xd = 1: yd = 1: a$ = "OK!": GOSUB PutCh
CASE "n"
done = 1: change = 1
GOSUB SetPalette
'xd = 1: yd = 1: a$ = "OK!": GOSUB PutCh
CASE "q": ERASE pal: EXIT DO
CASE CHR$(27): ERASE pal: EXIT DO
END SELECT
END IF
LOOP 'UNTIL INP(&H60) = 1
RETURN
ErrorInfo: '(rerr)
SOUND 1200, .5
COLOR 12, 0
PRINT "ERROR: ";
SELECT CASE rerr
CASE 1: PRINT "File not found!"
CASE 2: PRINT "It's not a BMP file!"
CASE 3: PRINT "This program can't support this FORMAT!"
CASE 4: PRINT "Width is too Large, MAX: 640(Color16);320(Color256)! Width="; wite
COLOR 11, 0: PRINT CHR$(13) + "You may try input:'"; : COLOR 10, 0: PRINT filename$; "/"; : COLOR 11, 0: PRINT "' to carry out it."
CASE 5: PRINT "Height is too Large, MAX: 480(Color16);200(Color256)! Hight="; high
COLOR 11, 0: PRINT CHR$(13) + "You may try input:'"; : COLOR 10, 0: PRINT filename$; "/"; : COLOR 11, 0: PRINT "' to carry out it."
CASE 6: PRINT "This file had been Compressed, I can't view it!"
CASE 7: PRINT "Error Filename!"
END SELECT
COLOR 14, 0: PRINT CHR$(13) + "You can input 'H' or 'h' to Read the Help"
COLOR 7, 0: PRINT CHR$(13) + "press any key to Return..."
a$ = INPUT$(1)
RETURN
PutCh: '(xd,yd,a$)
a = LEN(a$)
DIM pc%(a * 8 * 16)
GET (0, 0)-(a * 8 - 1, 15), pc%
LOCATE yd, xd: PRINT a$
PUT (0, 0), pc%, AND
DO: LOOP UNTIL INKEY$ <> ""
PUT (0, 0), pc%, PSET
ERASE pc%
RETURN
Help:
CLS
COLOR 14, 0: LOCATE 1, 38: PRINT "HELP"
COLOR 15, 0: PRINT CHR$(13) + "This program can show a BMP File which has not been Compressed."
COLOR 13, 0: PRINT CHR$(13) + "You can use it like this:"
PRINT " When the SYSTEM says:'All file name(*.bmp):', you should input the file name which you want to watch, Include '.BMP' or input 'H' to look this instruction, then SYSTEM will carry out your Command. If you input nothing,you will QUIT thisSYSTEM."
COLOR 11, 0: PRINT CHR$(13) + "About ERROR:"
PRINT " 1.File not found! (means can't find this file in the Directory) !! you can input Other File Name or COPY the File to this Directory to Solve it."
PRINT " 2.It's not a BMP file! (means the Inputed File is not a BMP File) !! you must input Other File Name again."
PRINT " 3.This program can't support this FORMAT! (means the file maybe use TureColor, this program only can view the File of which the Color Less then 256.)":
PRINT " 4.Width is too Large...! (means the width of the file is too Large) !! you may view it like this:" + CHR$(34) + "All file name(*.bmp):'"; : COLOR 12, 0: PRINT "filename/"; : COLOR 11, 0: PRINT "'" + CHR$(34) + "."
PRINT " 5.Height is too Large...! (means the height of the file is too Large) !! Way: As the Same as 4."
PRINT CHR$(13) + "press any key to contine..."
DO: LOOP UNTIL INKEY$ <> ""
PRINT " 6.This file had been Compressed...! (means it is a Compressed File) !! I'm sorry, I can do nothing with it."
PRINT " 7.Error Filename!(means it is not a legal filename) !! you must input legal filename."
COLOR 10, 0: PRINT CHR$(13) + "About CORTROL:"
PRINT " Parameter:'/' (input it Behind File Name when SYSTEM tell you to input file name.) >> show the file ALL SCREEN."
PRINT " xb: >> it's in the program, but you can use it to Change Width to Width*xb."
PRINT " yb: >> it's in the program, but you can use it to Change Height to Height*yb."
PRINT " Key Cortrol: use it when the file show Complete."
PRINT " 'c': >> Set the Color of the file Randomize."
PRINT " 'n': >> Carry out Negative Color."
PRINT " 'r': >> Return the Right Color."
PRINT " 'q' or 'ESC': >> Quit View."
PRINT CHR$(13) + "press any key to return..."
DO: LOOP UNTIL INKEY$ <> ""
COLOR 7, 0
GOTO main