There are three formulas which give slightly different results. To choose between the three, go to the TrueCOLOR13 sub program. Ildûrest's code alterations are set off by rows of asterisks. The first section is a formula which establishes a generic color table and the second contains the formulas which choose a hue from that table. Select one of the three formulas by removing REM's. To test, be sure to load a 24-bit bitmap. Other resolutions will load conventionally (e.g. 1, 4 and 8-bit).
-Bob
'Copy code from here -------------------------------------
'****************************************************************************
'WINBIT with a twist
'WINDOWS BITMAP LOADER (WINBIT.BAS)
'Revised by Ild–rest to load 24-bit images in color
'in SCREEN 13
'****************************************************************************
DEFINT A-Z
DECLARE SUB OneBIT12 ()
DECLARE SUB OneBIT13 ()
DECLARE SUB FourBIT ()
DECLARE SUB EightBIT ()
DECLARE SUB TrueCOLOR12 ()
DECLARE SUB TrueCOLOR13 ()
DECLARE SUB GetINFO (FileNAME$, display)
DIM SHARED PictureWIDTH&
DIM SHARED PictureDEPTH&
DIM SHARED NumCOLORS&
DIM SHARED OffsetBITS&
DIM SHARED BPP
'----------------- REGARDING THE GETINFO SUB PROGRAM ------------------------
' If you are working on a specific bitmap, just put its name between the
' quotes, otherwise you will be prompted for a file name every time you
' run the program.
' If you do not wish to see information on the file, such as file size,
' picture dimensions, etc., change the 1 to a 0.
GetINFO "", 1 '<-------adjust accordingly"
'----------------------------------------------------------------------------
SELECT CASE BPP
CASE 1: OneBIT12 '<---- If you wish 1-bit images to load in SCREEN 13
' rather than in SCREEN 12, then change this
' CALL to OneBIT13
CASE 4: FourBIT
CASE 8: EightBIT
CASE 24: TrueCOLOR13 '<---- If you wish 24-bit images to load in SCREEN 13
' with 64 grays rather than SCREEN 12 with 16
' grays, then change this CALL to TrueCOLOR13
END SELECT
CLOSE #1
'>>>>>>>>>>>>-PLACE ADDITIONAL CODE HERE (BSAVEing image, etc.)-<<<<<<<<<<<<
'---------------------------------------------------------------------------
A$ = INPUT$(1)
END
SUB EightBIT
IF PictureWIDTH& MOD 4 <> 0 THEN
ZeroPAD$ = SPACE$(4 - PictureWIDTH& MOD 4)
END IF
SCREEN 13
A$ = " "
FOR Colr = 0 TO NumCOLORS& - 1
OUT &H3C8, Colr
GET #1, , A$: Blu = INT(ASC(A$) / 4)
GET #1, , A$: Grn = INT(ASC(A$) / 4)
GET #1, , A$: Red = INT(ASC(A$) / 4)
OUT &H3C9, Red
OUT &H3C9, Grn
OUT &H3C9, Blu
GET #1, , A$ '--- unused byte
NEXT Colr
y = PictureDEPTH& - 1
o$ = " "
GET #1, OffsetBITS&, o$
A$ = " "
DO
x = 0
DO
GET #1, , A$
PSET (x, y), ASC(A$)
x = x + 1
LOOP WHILE x < PictureWIDTH&
GET #1, , ZeroPAD$
y = y - 1
LOOP UNTIL y = -1
END SUB
SUB FourBIT
IF PictureWIDTH& MOD 8 <> 0 THEN
ZeroPAD$ = SPACE$((8 - PictureWIDTH& MOD 8) \ 2)
END IF
SCREEN 12
A$ = " "
FOR Colr = 0 TO 15
OUT &H3C8, Colr
GET #1, , A$: Blu = INT(ASC(A$) / 4)
GET #1, , A$: Grn = INT(ASC(A$) / 4)
GET #1, , A$: Red = INT(ASC(A$) / 4)
OUT &H3C9, Red
OUT &H3C9, Grn
OUT &H3C9, Blu
GET #1, , A$ '--- unused byte
NEXT Colr
o$ = " "
GET #1, OffsetBITS&, o$
y = PictureDEPTH& - 1
A$ = " "
DO
x = 0
DO
GET #1, , A$
HiNIBBLE = ASC(A$) \ &H10
LoNIBBLE = ASC(A$) AND &HF
PSET (x, y), HiNIBBLE
x = x + 1
PSET (x, y), LoNIBBLE
x = x + 1
LOOP WHILE x < PictureWIDTH&
GET #1, , ZeroPAD$
y = y - 1
LOOP UNTIL y = -1
END SUB
SUB GetINFO (FileNAME$, display)
IF LEN(FileNAME$) = 0 THEN
COLOR 7, 1
CLS
FOR Row = 1 TO 25
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 25, Col: PRINT CHR$(196);
NEXT Col
LOCATE 1, 1: PRINT CHR$(218);
LOCATE 1, 80: PRINT CHR$(191);
LOCATE 25, 1: PRINT CHR$(192);
LOCATE 25, 80: PRINT CHR$(217);
COLOR 11, 1
LOCATE 6, 16: PRINT "PLEASE ENTER WINDOWS BITMAP FILE NAME"
COLOR 13
LOCATE 7, 16: PRINT STRING$(49, "-")
COLOR 7
LOCATE 8, 16: PRINT "You are personally responsible for entering the"
LOCATE 9, 16: PRINT "proper name and path (program will add the .BMP)"
LOCATE 11, 16: PRINT "Just press ENTER to quit"
COLOR 15
LOCATE 13, 16: INPUT ""; FileNAME$
END IF
IF LEN(FileNAME$) THEN
FileNAME$ = FileNAME$ + ".BMP"
OPEN FileNAME$ FOR BINARY AS #1
ELSE
COLOR 7, 0 'reset DOS defaults
CLS
SYSTEM
END IF
FileTYPE$ = SPACE$(2)
GET #1, , FileTYPE$
GET #1, , FileSIZE&
GET #1, , Reserved1 'should be zero
GET #1, , Reserved2 'should be zero
GET #1, , OffsetBITS&
GET #1, , infoheader&
GET #1, , PictureWIDTH&
GET #1, , PictureDEPTH&
GET #1, , NumPLANES
GET #1, , BPP
GET #1, , Compression&
GET #1, , ImageSIZE&
GET #1, , WidthPELS&
GET #1, , DepthPELS&
GET #1, , NumCOLORS&
GET #1, , SigCOLORS&
IF display THEN
CLS
COLOR 9, 1
CLS
PRINT
PRINT
COLOR 13
PRINT " FILE INFORMATION"
COLOR 7
PRINT " " + STRING$(40, "-")
COLOR 11
PRINT " " + CHR$(175) + " File type: "; FileTYPE$
PRINT " " + CHR$(175) + " File size:"; FileSIZE&
PRINT " " + CHR$(175) + " Reserved1:"; Reserved1
PRINT " " + CHR$(175) + " Reserved2:"; Reserved2
PRINT " " + CHR$(175) + " Offset :"; OffsetBITS&
PRINT
COLOR 12
PRINT " " + CHR$(175) + " Information header size is"; infoheader&
PRINT " " + CHR$(175) + " Picture width:"; : COLOR 14: PRINT PictureWIDTH&
COLOR 12
PRINT " " + CHR$(175) + " Picture depth:"; : COLOR 14: PRINT PictureDEPTH&
COLOR 12
PRINT " " + CHR$(175) + " Number of planes:"; NumPLANES
PRINT " " + CHR$(175) + " Bits per pixel:"; : COLOR 14: PRINT BPP
COLOR 12
PRINT " " + CHR$(175) + " Compression:"; Compression&
PRINT " " + CHR$(175) + " Number of pixels in image:"; ImageSIZE&
PRINT " " + CHR$(175) + " Width in pels per metre:"; WidthPELS&
PRINT " " + CHR$(175) + " Depth in pels per metre:"; DepthPELS&
PRINT " " + CHR$(175) + " Number of colors used:"; NumCOLORS&;
PRINT "(zero = 24-bit color)"
PRINT " " + CHR$(175);
PRINT USING " Significant colors used:### (zero = all)"; SigCOLORS&
PRINT
COLOR 11
PRINT " PRESS ANY KEY TO DISPLAY BITMAP...";
COLOR 7
PRINT " (Large images take a while to appear)";
COLOR 9
FOR Row = 1 TO 25
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 25, Col: PRINT CHR$(196);
NEXT Col
LOCATE 1, 1: PRINT CHR$(218);
LOCATE 1, 80: PRINT CHR$(191);
LOCATE 25, 1: PRINT CHR$(192);
LOCATE 25, 80: PRINT CHR$(217);
Pause$ = INPUT$(1)
END IF
COLOR 7, 0 'reset DOS defaults
CLS
END SUB
SUB OneBIT12
BitsOVER% = PictureWIDTH& MOD 32
IF BitsOVER% THEN ZeroPAD$ = SPACE$((32 - BitsOVER%) \ 8)
'Hop$ = SPACE$(8)
'GET #1, , Hop$ 'bypass color table
SCREEN 12
y = PictureDEPTH& - 1
o$ = " "
GET #1, OffsetBITS&, o$
A$ = " "
DO
x = 0
DO
GET #1, , A$
CharVAL = ASC(A$)
Bit = 128
FOR BitCOUNT = 1 TO 8
IF CharVAL AND Bit THEN PSET (x, y), 15 ELSE PSET (x, y), 0
Bit = Bit / 2
x = x + 1
NEXT BitCOUNT
LOOP WHILE x < PictureWIDTH&
GET #1, , ZeroPAD$
y = y - 1
LOOP UNTIL y = -1
END SUB
SUB OneBIT13
BitsOVER% = PictureWIDTH& MOD 32
IF BitsOVER% THEN ZeroPAD$ = SPACE$((32 - BitsOVER%) \ 8)
Hop$ = SPACE$(8)
GET #1, , Hop$ 'bypass color table
SCREEN 13
y = PictureDEPTH& - 1
o$ = " "
GET #1, OffsetBITS&, o$
A$ = " "
DO
x = 0
DO
GET #1, , A$
CharVAL = ASC(A$)
Bit = 128
FOR BitCOUNT = 1 TO 8
IF CharVAL AND Bit THEN PSET (x, y), 15 ELSE PSET (x, y), 0
Bit = Bit / 2
x = x + 1
NEXT BitCOUNT
LOOP WHILE x < PictureWIDTH&
GET #1, , ZeroPAD$
y = y - 1
LOOP UNTIL y = -1
END SUB
SUB TrueCOLOR12
IF ((PictureWIDTH& * 3) MOD 4) <> 0 THEN
ZeroPAD$ = SPACE$((4 - ((PictureWIDTH& * 3) MOD 4)))
END IF
SCREEN 12
n = 3
FOR Colr = 0 TO 15
'IF n > 5 THEN Blues = 5 ELSE Blues = 0 + n
OUT &H3C8, Colr
OUT &H3C9, n - Blues
OUT &H3C9, n - Blues
OUT &H3C9, n
n = n + 4
NEXT Colr
y = PictureDEPTH& - 1
o$ = " "
GET #1, OffsetBITS&, o$
A$ = " "
B$ = " "
c$ = " "
DO
x = 0
DO
GET #1, , A$
GET #1, , B$
GET #1, , c$
A = ASC(A$)
B = ASC(B$)
c = ASC(c$)
d = (A + B + c) \ 48
PSET (x, y), d
x = x + 1
LOOP WHILE x < PictureWIDTH&
GET #1, , ZeroPAD$
y = y - 1
LOOP UNTIL y = -1
END SUB
SUB TrueCOLOR13
IF ((PictureWIDTH& * 3) MOD 4) <> 0 THEN
ZeroPAD$ = SPACE$((4 - ((PictureWIDTH& * 3) MOD 4)))
END IF
SCREEN 13
'Ild–rest's formula for creating multi-use color table '*********************
OUT &H3C8, 0
FOR i = 0 TO 251
OUT &H3C9, (i MOD 6) * 63 \ 5
OUT &H3C9, ((i \ 36) MOD 7) * 63 \ 6
OUT &H3C9, ((i \ 6) MOD 6) * 63 \ 5
NEXT
'****************************************************************************
y = PictureDEPTH& - 1
o$ = " "
GET #1, OffsetBITS&, o$
A$ = " "
B$ = " "
c$ = " "
DO
x = 0
DO
GET #1, , A$
GET #1, , B$
GET #1, , c$
A = ASC(A$)
B = ASC(B$)
c = ASC(c$)
'****************************************************************************
'Ild–rest's formulas for establishing color relative to his color table
'REM the option you don't wish to use, and un-REM the option you wish to use
'OPTION 1 FORMULA:
d = c * 5 \ 255 + (B * 6 \ 255) * 36 + (A * 5 \ 255) * 6
'OPTION 2 FORMULA:
REM d = INT(SIN((c - 127.5) * ATN(1) * 2 / 127.5) * 2.99 + 3) + INT(SIN((b - 127.5) * ATN(1) * 2 / 127.5) * 3.49 + 3.5) * 36 + INT(SIN((a - 127.5) * ATN(1) * 2 / 127.5) * 2.99 + 3) * 6
'OPTION 3 FORMULA:
REM d = INT(TAN((C - 127.5) * ATN(1) / 127.5) * 2.99 + 3) + INT(TAN((B - 127.5) * ATN(1) / 127.5) * 3.49 + 3.5) * 36 + INT(TAN((A - 127.5) * ATN(1) / 127.5) * 2.99 + 3) * 6
'****************************************************************************
PSET (x, y), d
x = x + 1
LOOP WHILE x < PictureWIDTH&
GET #1, , ZeroPAD$
y = y - 1
LOOP UNTIL y = -1
END SUB
This message has been edited by qb432l on Jan 7, 2008 4:22 AM
This message has been edited by qb432l on Jan 7, 2008 12:05 AM
|
|