中国DOS联盟

DECLARE SUB ChangePalette (Alg%)
DECLARE SUB Open24 (FileName$)

TYPE BMPHeader
ValidID AS STRING * 2 '/* Must be 'BM'
SizeOfFile AS LONG '/* Size of entire file in bytes
Reserved AS LONG '/* Four empty bytes
OffsetOfBitMap AS LONG '/* The location in the file where the
' bitmap is located
END TYPE

TYPE WindowsBMPInfoHeader
SizeOfHeader AS LONG '/* Size of Information Header
' 40 - Windows | 12 - OS/2 1.x | 64 OS/2 2.x
Widthz AS LONG '/* Width of image in pixels
Heightz AS LONG '/* Height of image in pixels
Planes AS INTEGER '/* Number of Planes. Must be '1'
BitsPerPixel AS INTEGER '/* Number of bits per pixel
' Possible values are 1,4,8,16,24,32
CompressMethod AS LONG '/* Compression Method
' 0 - Uncompressed
' 1 - 8 Bit RLE Compression
' 2 - 4 Bit RLE Compression
ImageSizeInBytes AS LONG '/* Size of image in bytes
HorizontalResol AS LONG '/* Horizontal Resolution
VerticalResol AS LONG '/* Vertical Resolution
ColorsUsed AS LONG '/* Number of Colors used | 0 - All Used
ImportantColors AS LONG '/* Number of Important Colors
END TYPE

CLS
FILES "*.bmp"
PRINT " 1st 24-BIT BMP Loader for Qbasic (ver 0.1) - A YPI Product"
INPUT " Enter File Name - ", FileName$
IF INSTR(FileName$, ".bmp" = 0 THEN FileName$ = FileName$ + ".bmp"
CALL Open24(FileName$)

WHILE INKEY$ "": WEND
in$ = INPUT$(1)
SCREEN 2: SCREEN 0
PRINT " 1st 24-BIT BMP Loader for Qbasic (ver 0.1) - By YPI (BASIC Programming Inc.)"
PRINT " Program is Public Domain, (c) Copyrighted by YPI, All Rights Reserved"
PRINT " Programmed By Yousuf Philips in 1998"
PRINT " Send suggestions and comments to philipz85@hotmail.com"
PRINT " If you have a better color palette, please send it to us"
PRINT " Visit the YPI Website at http://members.xoom.com/Philipz/"
Wait$ = INPUT$(1)
DEFINT A-Z
'

'/* Sub to change the color palette */'
SUB ChangePalette (Alg)

IF Alg = 1 THEN
'/* An excellent color palette from PALSTUFF.BAS */'
'/* Created by Steve Demo */'
Change$ = "#####M#M##MMM##M#MM8#MMM88888b8b88bbb88b8bbb8bbb+++"
Change$ = Change$ + "...222555999===@@@DDDHHHKKKOOOSSSVVVZZZ^^^bbb3##8##"
Change$ = Change$ + "=##?&&B**E--H11K55N88Q<#\B*]F2^K:_OA`TIaXQb]Y33#66#99#<<#"
Change$ = Change$ + "??#BB#EE#HH#LL#OO#RR#UU#XX#



_#bYb`S`^N^\H\ZCZX=XV8VT3UP0QL.MH+I"
Change$ = Change$ + "D(EA&A<%<7$73#3-+&1-'5/):2+;3+=4,?5-@6-B7.D8/E9/G:0"
Change$ = Change$ + "I;1J3O?3Q@4SA5UB6VD8WF;XH>YJAZMDSM^VP"
Change$ = Change$ + "_XS`ZVb]ZZ##X)#W0#U6#T;#S@#RF#PJ#ON#CN#6M#*M##L(#K3"
Change$ = Change$ + "#K?#KH#FL#>M#5M#-N6#Q>#QD#QL#QQ#NQ#FQ#@Q#9Q#1R#+R##"
Change$ = Change$ + "bbb"
FOR Loops = 0 TO 255
OUT &H3C8, Loops
OUT &H3C9, ASC(MID$(Change$, Loops * 3 + 1, 1)) - 35
OUT &H3C9, ASC(MID$(Change$, Loops * 3 + 2, 1)) - 35
OUT &H3C9, ASC(MID$(Change$, Loops * 3 + 3, 1)) - 35
NEXT Loops
Change$ = ""
ELSE
'/* Randomized color palette */'
FOR Loops = 1 TO 255
Blue = INT(RND * 256) \ 4
Green = INT(RND * 256) \ 4
Red = INT(RND * 256) \ 4
OUT &H3C8, Loops
OUT &H3C9, Red
OUT &H3C9, Green
OUT &H3C9, Blue
NEXT Loops
END IF

END SUB

SUB Open24 (FileName$)

DIM BMPHeader AS BMPHeader
DIM BMPInfoHeader AS WindowsBMPInfoHeader

'/* Open file and check if it is empty */'
OPEN FileName$ FOR BINARY AS #255
IF LOF(255) = 0 THEN
PRINT " File Is Empty"
CLOSE
KILL FileName$
EXIT SUB
END IF

'/* Extract BMP information from the file */'
GET #255, , BMPHeader
GET #255, , BMPInfoHeader

IF BMPHeader.ValidID "BM" THEN
PRINT " Invalid BMP File"
EXIT SUB
ELSEIF BMPInfoHeader.BitsPerPixel 24 THEN
PRINT " Not 24-bit Image "
EXIT SUB
END IF

DIM ColorPalette(255, 3)
DIM PixelArray(2000, 3)
ColorDif = 3

SCREEN 13
'/* Sub which changes the palette */'
'/* Valid values - 1 - Color Palette created by Steve Demo */'
'/* 0 - Random Color Palette */'
'/* If you want to use your own color palette edit the function, and if you*/'
'/* think you palette works well with the program send it to us. */'
CALL ChangePalette(1)

'/* Capture the current color palette into an array */'
FOR Loops = 0 TO 255
OUT &H3C7, Loops
ColorPalette(Loops, 1) = INP(&H3C9)
ColorPalette(Loops, 2) = INP(&H3C9)
ColorPalette(Loops, 3) = INP(&H3C9)
NEXT Loops

'/* Calculate the number of bytes per line for the current image */'
LineExtract$ = SPACE$(BMPInfoHeader.Widthz * 3)
IF (4 - ((BMPInfoHeader.Widthz * 3) MOD 4)) 4 THEN
LineExtract$ = LineExtract$ + SPACE$(4 - ((BMPInfoHeader.Widthz * 3) MOD 4))
END IF
LineExtract& = LEN(LineExtract$)

IF BMPHeader.OffsetOfBitMap = 0 THEN BMPHeader.OffsetOfBitMap = 55

'/* Resize image to fit the Screen */'
ActualHeight! = 199 / (BMPInfoHeader.Heightz - 1)
ActualWidth! = 319 / (BMPInfoHeader.Widthz - 1)
IF ActualHeight! > 1 THEN ActualHeight! = 1
IF ActualWidth! > 1 THEN ActualWidth! = 1
ActualHeight1! = (BMPInfoHeader.Heightz - 1) / 199
ActualWidth1! = (BMPInfoHeader.Widthz - 1) / 319
IF ActualHeight1! < 1 THEN ActualHeight1! = 1
IF ActualWidth1! < 1 THEN ActualWidth1! = 1
WHILE INKEY$ "": WEND

FOR YHeight = BMPInfoHeader.Heightz - 1 TO 0 STEP -ActualHeight1!
'/* Extract only the image lines which will be shown */'
GET #255, BMPHeader.OffsetOfBitMap + ((BMPInfoHeader.Heightz - YHeight - 1) * LineExtract& + 1, LineExtract$
FOR XWidth = 0 TO BMPInfoHeader.Widthz - 1 STEP ActualWidth1!
XWidthPosition = XWidth * 3
'/* Extract the RGB of each pixel */'
PixelBlue = ASC(MID$(LineExtract$, XWidthPosition + 1, 1)) \ 4
PixelGreen = ASC(MID$(LineExtract$, XWidthPosition + 2, 1)) \ 4
PixelRed = ASC(MID$(LineExtract$, XWidthPosition + 3, 1)) \ 4
PixelPut = 0: Movement = 0
'/* Check if the RGB or an RGB close to it are in the color array */'
FOR PixelArraySearch = 1 TO ArrayNo
IF PixelBlue >= PixelArray(PixelArraySearch, 1) - ColorDif AND PixelBlue = PixelArray(PixelArraySearch, 2) - ColorDif AND PixelGreen = PixelArray(PixelArraySearch, 3) - ColorDif AND PixelRed = (ColorPalette(Loops, 3) - Movement) AND PixelBlue = (ColorPalette(Loops, 2) - Movement) AND PixelGreen = (ColorPalette(Loops, 1) - Movement) AND PixelRed 3 THEN
IF PixelBlue = PixelGreen AND PixelBlue = PixelRed THEN
PSET (XWidth * ActualWidth!, YHeight * ActualHeight!), Loops
IF ArrayNo < 2000 THEN
ArrayNo = ArrayNo + 1
PixelArray(ArrayNo, 1) = PixelBlue
PixelArray(ArrayNo, 2) = PixelGreen
PixelArray(ArrayNo, 3) = PixelRed
PixelArray(ArrayNo, 0) = Loops
END IF
EXIT DO
END IF
ELSE
PSET (XWidth * ActualWidth!, YHeight * ActualHeight!), Loops
IF ArrayNo < 2000 THEN
ArrayNo = ArrayNo + 1
PixelArray(ArrayNo, 1) = PixelBlue
PixelArray(ArrayNo, 2) = PixelGreen
PixelArray(ArrayNo, 3) = PixelRed
PixelArray(ArrayNo, 0) = Loops
END IF
EXIT DO
END IF
END IF
END IF
END IF
NEXT Loops
Movement = Movement + 1
LOOP
END IF
NEXT XWidth
NEXT YHeight
CLOSE

END SUB