Code: Select all
'**************************************************************
'
'----- BITMAP.BAS ---------------------------------------------
'
'----- Creates Windows bitmaps out of SCREEN 12/13 images -----
'----- Windows bitmap file structure courtesy WOTSIT.ORG ------
'--------- Freeware by Bob Seguin 2003 -- (TheBOB) ------------
'
'---- Decreased time of 4 bit fullscreen to 8 seconds ---------
' Ted Weissgerber July, 2008
'- Add a special keypress to a program to create a Screenshot -
'
'**************************************************************
DECLARE SUB FourBIT (x1%, y1%, x2%, y2%, Filename$) '12 or 13 using 16 colors
DECLARE SUB EightBIT (x1%, y1%, x2%, y2%, Filename$) '13 using 256 colors
'******************* DEMO or your own program code ********************
'Demonstrates CALLs to SUB programs (can make a screen shot of any program)
'Maximum width value for x2% = 639 in Screen 12 or 319 in Screen 13
'Maximum depth value for y2% = 479 in Screen 12 or 199 in Screen 13
'Minimums for x1% and y1% can be no less than 0
DO: CLS
INPUT "ENTER Screen Mode 12 or 13 (0 quits): ", scrn%
IF scrn% = 13 THEN
SCREEN 13 '8 bit (256 colors) only
LINE (0, 0)-(319, 199), 13, BF
CIRCLE (160, 100), 50, 11
PAINT STEP(0, 0), 9, 11
Start! = TIMER
EightBIT 0, 0, 319, 199, "Purple8"
ELSEIF scrn% = 12 THEN
SCREEN 12 '4 bit(16 colors) only
LINE (0, 0)-(639, 479), 13, BF
LINE (100, 100)-(500, 400), 12, BF
CIRCLE (320, 240), 100, 11
PAINT STEP(0, 0), 9, 11
Start! = TIMER
FourBIT 0, 0, 639, 479, "Purple4" '469, 239
ELSE : SYSTEM
END IF
Finish! = TIMER
PRINT "Elapsed time ="; Finish! - Start!; "secs."; "Press Escape to quit!"
DO: K$ = INKEY$: LOOP UNTIL K$ <> ""
LOOP UNTIL K$ = CHR$(27)
SYSTEM
'******************************** End DEMO code ************************
SUB EightBIT (x1%, y1%, x2%, y2%, Filename$) 'SCREEN 13 bitmap maker
'takes 1 second fullscreen
DIM FileCOLORS%(1 TO 768)
DIM Colors8%(255)
IF INSTR(Filename$, ".BMP") = 0 THEN
Filename$ = RTRIM$(LEFT$(Filename$, 8)) + ".BMP"
END IF
FileTYPE$ = "BM"
Reserved1% = 0
Reserved2% = 0
OffsetBITS& = 1078
InfoHEADER& = 40
PictureWIDTH& = x2% - x1% + 1
PictureDEPTH& = y2% - y1% + 1
NumPLANES% = 1
BPP% = 8
Compression& = 0
WidthPELS& = 3780
DepthPELS& = 3780
NumCOLORS& = 256
IF PictureWIDTH& MOD 4 <> 0 THEN
ZeroPAD$ = SPACE$(4 - PictureWIDTH& MOD 4)
END IF
ImageSIZE& = (PictureWIDTH& + LEN(ZeroPAD$)) * PictureDEPTH&
FileSize& = ImageSIZE& + OffsetBITS&
OUT &H3C7, 0
FOR n = 1 TO 768 STEP 3
FileCOLORS%(n) = INP(&H3C9)
FileCOLORS%(n + 1) = INP(&H3C9)
FileCOLORS%(n + 2) = INP(&H3C9)
NEXT n
OPEN Filename$ FOR BINARY AS #1
PUT #1, , FileTYPE$
PUT #1, , FileSize&
PUT #1, , Reserved1% 'should be zero
PUT #1, , Reserved2% 'should be zero
PUT #1, , OffsetBITS&
PUT #1, , InfoHEADER&
PUT #1, , PictureWIDTH&
PUT #1, , PictureDEPTH&
PUT #1, , NumPLANES%
PUT #1, , BPP%
PUT #1, , Compression&
PUT #1, , ImageSIZE&
PUT #1, , WidthPELS&
PUT #1, , DepthPELS&
PUT #1, , NumCOLORS&
PUT #1, , SigCOLORS& '51 to 54
u$ = " "
FOR n% = 1 TO 768 STEP 3 'PUT as BGR order colors
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 'place bottom up
FOR x = x1% TO x2%
a$ = CHR$(POINT(x, y))
Colors8%(ASC(a$)) = 1
PUT #1, , a$
NEXT x
PUT #1, , ZeroPAD$
NEXT y
FOR n = 0 TO 255
IF Colors8%(n) = 1 THEN SigCOLORS& = SigCOLORS& + 1
NEXT n
PUT #1, 51, SigCOLORS&
CLOSE #1
END SUB
'********************* Four Bit
SUB FourBIT (x1%, y1%, x2%, y2%, Filename$) 'SCREEN 12 bitmap maker
'fullscreen takes about 8 seconds
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&
OUT &H3C7, 0 'start at color 0
FOR n = 1 TO 48 STEP 3
FileCOLORS%(n) = INP(&H3C9)
FileCOLORS%(n + 1) = INP(&H3C9)
FileCOLORS%(n + 2) = INP(&H3C9)
NEXT n
OPEN Filename$ FOR BINARY AS #1
'Header bytes
PUT #1, , FileTYPE$ '2 '1 to 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$ = " " 'unused byte
FOR n% = 1 TO 46 STEP 3 'PUT as BGR order colors
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$ 'add Unused byte
NEXT n%
FOR y = y2% TO y1% STEP -1 'Place from bottom up
FOR x = x1% TO x2% STEP 2 'nibble steps
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 'optional sound if available for 4 bit only
END SUB