Difference between revisions of "Program ScreenShots"

From QB64 Wiki
Jump to navigation Jump to search
imported>Clippy
m
imported>Clippy
Line 2: Line 2:
  
  
* Demonstrates [[CALL]]s to the two [[SUB]] programs to make a screen shot of any program.
+
''Syntax:'' EightBit Minimum_Column%, Minimum_Row%, Maximum_Column%, Maximum_Row%, NewFileName$
 +
 
 +
 
 +
* The values of x1%, y%1, x2% and y2% can be any ON SCREEN area coordinates in the screen mode used.
 +
* You MUST subtract one from x2% and y2% when using the '''QB64'''  FULL SCREEN [[_WIDTH]] and [[_HEIGHT]] values! Otherwise [[POINT]] may return an [[ERROR Codes|Illegal function error]]! The maximum is one pixel less than the [[SCREEN (statement)| SCREEN]] resolution or the [[_NEWIMAGE]] dimensions.
 +
* Coordinate values cannot be off of the screen!
 
* Can create QB64 screenshots of [[_NEWIMAGE]] screen pages.
 
* Can create QB64 screenshots of [[_NEWIMAGE]] screen pages.
 
* Can also copy images loaded using the [[_LOADIMAGE]] function.
 
* Can also copy images loaded using the [[_LOADIMAGE]] function.
* 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% cannot be less than 0
 
 
* Both [[SUB]]s can be used in '''QB64''' or Qbasic! The FourBit SUB takes about 8 seconds in QB.
 
* Both [[SUB]]s can be used in '''QB64''' or Qbasic! The FourBit SUB takes about 8 seconds in QB.
 
* FourBit SUB creates 4 BPP(16 color) and EightBit SUB creates 8 BPP(256 color) bitmaps.
 
* FourBit SUB creates 4 BPP(16 color) and EightBit SUB creates 8 BPP(256 color) bitmaps.
Line 18: Line 20:
 
'|                                                                                  |
 
'|                                                                                  |
 
'|  ---- Decreased {{Cl|POINT}} time of 4 bit fullscreen to 8 seconds in Qbasic ----      |
 
'|  ---- Decreased {{Cl|POINT}} time of 4 bit fullscreen to 8 seconds in Qbasic ----      |
'|                     Ted Weissgerber July, 2008                                   |
+
'|                     by Ted Weissgerber July, 2008                                 |
 
'|    - Add a special keypress to a game program to create a Screenshot -          |
 
'|    - Add a special keypress to a game program to create a Screenshot -          |
 +
'|                                                                                  |
 
'--------------------------------- DEMO CODE -----------------------------------------
 
'--------------------------------- DEMO CODE -----------------------------------------
  
Line 58: Line 61:
 
''
 
''
 
{{Cl|SUB}} EightBIT (x1%, y1%, x2%, y2%, Filename$)  'SCREEN 13(256 color) bitmap maker
 
{{Cl|SUB}} EightBIT (x1%, y1%, x2%, y2%, Filename$)  'SCREEN 13(256 color) bitmap maker
                                             
+
'NOTE: Adjust x2% = 319 and y2% = 199 for legal POINTs when fullscreen in SCREEN 13
{{Cl|DIM}} File{{Cl|COLOR}}S%(1 {{Cl|TO}} 768)
+
{{Cl|DIM}} FileCOLORS%(1 {{Cl|TO}} 768)
 
{{Cl|DIM}} Colors8%(255)
 
{{Cl|DIM}} Colors8%(255)
 
{{Cl|IF}} x1% > x2% {{Cl|THEN}} {{Cl|SWAP}} x1%, x2%
 
{{Cl|IF}} x1% > x2% {{Cl|THEN}} {{Cl|SWAP}} x1%, x2%
Line 68: Line 71:
 
{{Cl|END IF}}
 
{{Cl|END IF}}
  
File{{Cl|TYPE}}$ = "BM"
+
FileTYPE$ = "BM"
 
Reserved1% = 0
 
Reserved1% = 0
 
Reserved2% = 0
 
Reserved2% = 0
 
OffsetBITS& = 1078
 
OffsetBITS& = 1078
 
InfoHEADER& = 40
 
InfoHEADER& = 40
Picture{{Cl|WIDTH}}& = (x2% - x1%) + 1
+
PictureWIDTH& = (x2% - x1%) + 1
 
PictureDEPTH& = (y2% - y1%) + 1
 
PictureDEPTH& = (y2% - y1%) + 1
 
NumPLANES% = 1
 
NumPLANES% = 1
Line 80: Line 83:
 
WidthPELS& = 3780
 
WidthPELS& = 3780
 
DepthPELS& = 3780
 
DepthPELS& = 3780
Num{{Cl|COLOR}}S& = 256
+
NumCOLORS& = 256
  
{{Cl|IF}} Picture{{Cl|WIDTH}}& {{Cl|MOD}} 4 <> 0 {{Cl|THEN}}
+
{{Cl|IF}} PictureWIDTH& {{Cl|MOD}} 4 <> 0 {{Cl|THEN}}
   ZeroPAD$ = {{Cl|SPACE$}}(4 - Picture{{Cl|WIDTH}}& {{Cl|MOD}} 4)
+
   ZeroPAD$ = {{Cl|SPACE$}}(4 - PictureWIDTH& {{Cl|MOD}} 4)
 
{{Cl|END IF}}
 
{{Cl|END IF}}
  
Line 91: Line 94:
 
{{Cl|OUT}} {{Cl|&H}}3C7, 0
 
{{Cl|OUT}} {{Cl|&H}}3C7, 0
 
{{Cl|FOR}} n = 1 {{Cl|TO}} 768 {{Cl|STEP}} 3
 
{{Cl|FOR}} n = 1 {{Cl|TO}} 768 {{Cl|STEP}} 3
   File{{Cl|COLOR}}S%(n) = {{Cl|INP}}({{Cl|&H}}3C9)
+
   FileCOLORS%(n) = {{Cl|INP}}({{Cl|&H}}3C9)
   File{{Cl|COLOR}}S%(n + 1) = {{Cl|INP}}({{Cl|&H}}3C9)
+
   FileCOLORS%(n + 1) = {{Cl|INP}}({{Cl|&H}}3C9)
   File{{Cl|COLOR}}S%(n + 2) = {{Cl|INP}}({{Cl|&H}}3C9)
+
   FileCOLORS%(n + 2) = {{Cl|INP}}({{Cl|&H}}3C9)
 
{{Cl|NEXT}} n
 
{{Cl|NEXT}} n
  
 
{{Cl|OPEN}} Filename$ {{Cl|FOR (file statement)|FOR}} {{Cl|BINARY}} {{Cl|AS}} #1
 
{{Cl|OPEN}} Filename$ {{Cl|FOR (file statement)|FOR}} {{Cl|BINARY}} {{Cl|AS}} #1
  
{{Cl|PUT|PUT #}}1, , File{{Cl|TYPE}}$
+
{{Cl|PUT|PUT #}}1, , FileTYPE$
 
{{Cl|PUT|PUT #}}1, , FileSize&
 
{{Cl|PUT|PUT #}}1, , FileSize&
 
{{Cl|PUT|PUT #}}1, , Reserved1% 'should be zero
 
{{Cl|PUT|PUT #}}1, , Reserved1% 'should be zero
Line 104: Line 107:
 
{{Cl|PUT|PUT #}}1, , OffsetBITS&
 
{{Cl|PUT|PUT #}}1, , OffsetBITS&
 
{{Cl|PUT|PUT #}}1, , InfoHEADER&
 
{{Cl|PUT|PUT #}}1, , InfoHEADER&
{{Cl|PUT|PUT #}}1, , Picture{{Cl|WIDTH}}&
+
{{Cl|PUT|PUT #}}1, , PictureWIDTH&
 
{{Cl|PUT|PUT #}}1, , PictureDEPTH&
 
{{Cl|PUT|PUT #}}1, , PictureDEPTH&
 
{{Cl|PUT|PUT #}}1, , NumPLANES%
 
{{Cl|PUT|PUT #}}1, , NumPLANES%
Line 112: Line 115:
 
{{Cl|PUT|PUT #}}1, , WidthPELS&
 
{{Cl|PUT|PUT #}}1, , WidthPELS&
 
{{Cl|PUT|PUT #}}1, , DepthPELS&
 
{{Cl|PUT|PUT #}}1, , DepthPELS&
{{Cl|PUT|PUT #}}1, , Num{{Cl|COLOR}}S&
+
{{Cl|PUT|PUT #}}1, , NumCOLORS&
{{Cl|PUT|PUT #}}1, , Sig{{Cl|COLOR}}S&    '51 to 54
+
{{Cl|PUT|PUT #}}1, , SigCOLORS&    '51 to 54
  
 
u$ = " "
 
u$ = " "
 
{{Cl|FOR}} n% = 1 {{Cl|TO}} 768 {{Cl|STEP}} 3  '{{Cl|PUT (graphics statement)|PUT}} as BGR order colors
 
{{Cl|FOR}} n% = 1 {{Cl|TO}} 768 {{Cl|STEP}} 3  '{{Cl|PUT (graphics statement)|PUT}} as BGR order colors
   Colr$ = {{Cl|CHR$}}(File{{Cl|COLOR}}S%(n% + 2) * 4)
+
   Colr$ = {{Cl|CHR$}}(FileCOLORS%(n% + 2) * 4)
 
   {{Cl|PUT|PUT #}}1, , Colr$
 
   {{Cl|PUT|PUT #}}1, , Colr$
   Colr$ = {{Cl|CHR$}}(File{{Cl|COLOR}}S%(n% + 1) * 4)
+
   Colr$ = {{Cl|CHR$}}(FileCOLORS%(n% + 1) * 4)
 
   {{Cl|PUT|PUT #}}1, , Colr$
 
   {{Cl|PUT|PUT #}}1, , Colr$
   Colr$ = {{Cl|CHR$}}(File{{Cl|COLOR}}S%(n%) * 4)
+
   Colr$ = {{Cl|CHR$}}(FileCOLORS%(n%) * 4)
 
   {{Cl|PUT|PUT #}}1, , Colr$
 
   {{Cl|PUT|PUT #}}1, , Colr$
 
   {{Cl|PUT|PUT #}}1, , u$ 'Unused byte
 
   {{Cl|PUT|PUT #}}1, , u$ 'Unused byte
Line 136: Line 139:
  
 
{{Cl|FOR}} n = 0 {{Cl|TO}} 255
 
{{Cl|FOR}} n = 0 {{Cl|TO}} 255
   {{Cl|IF}} Colors8%(n) = 1 {{Cl|THEN}} Sig{{Cl|COLOR}}S& = Sig{{Cl|COLOR}}S& + 1
+
   {{Cl|IF}} Colors8%(n) = 1 {{Cl|THEN}} SigCOLORS& = SigCOLORS& + 1
 
{{Cl|NEXT}} n
 
{{Cl|NEXT}} n
  
{{Cl|PUT|PUT #}}1, 51, Sig{{Cl|COLOR}}S&
+
{{Cl|PUT|PUT #}}1, 51, SigCOLORS&
 
{{Cl|CLOSE}} #1
 
{{Cl|CLOSE}} #1
 
{{Cl|END SUB}}     
 
{{Cl|END SUB}}     
Line 149: Line 152:
 
{{Cl|SUB}} FourBIT (x1%, y1%, x2%, y2%, Filename$)    SCREEN 12(16 color) bitmap maker
 
{{Cl|SUB}} FourBIT (x1%, y1%, x2%, y2%, Filename$)    SCREEN 12(16 color) bitmap maker
 
       'fullscreen takes about 8 seconds in QB
 
       'fullscreen takes about 8 seconds in QB
{{Cl|DIM}} File{{Cl|COLOR}}S%(1 {{Cl|TO}} 48)
+
'NOTE: Adjust x2% = 639 and y2% = 479 for legal POINTs when fullscreen in SCREEN 12
 +
{{Cl|DIM}} FileCOLORS%(1 {{Cl|TO}} 48)
 
{{Cl|DIM}} Colors4%(0 {{Cl|TO}} 15)
 
{{Cl|DIM}} Colors4%(0 {{Cl|TO}} 15)
 
{{Cl|IF}} x1% > x2% {{Cl|THEN}} {{Cl|SWAP}} x1%, x2%
 
{{Cl|IF}} x1% > x2% {{Cl|THEN}} {{Cl|SWAP}} x1%, x2%
Line 158: Line 162:
 
{{Cl|END IF}}
 
{{Cl|END IF}}
 
    
 
    
File{{Cl|TYPE}}$ = "BM"
+
FileTYPE$ = "BM"
 
Reserved1% = 0
 
Reserved1% = 0
 
Reserved2% = 0
 
Reserved2% = 0
 
OffsetBITS& = 118
 
OffsetBITS& = 118
 
InfoHEADER& = 40
 
InfoHEADER& = 40
Picture{{Cl|WIDTH}}& = (x2% - x1%) + 1
+
PictureWIDTH& = (x2% - x1%) + 1
 
PictureDEPTH& = (y2% - y1%) + 1
 
PictureDEPTH& = (y2% - y1%) + 1
 
NumPLANES% = 1
 
NumPLANES% = 1
Line 170: Line 174:
 
WidthPELS& = 3780
 
WidthPELS& = 3780
 
DepthPELS& = 3780
 
DepthPELS& = 3780
Num{{Cl|COLOR}}S& = 16
+
NumCOLORS& = 16
  
{{Cl|IF}} Picture{{Cl|WIDTH}}& {{Cl|MOD}} 8 <> 0 {{Cl|THEN}}
+
{{Cl|IF}} PictureWIDTH& {{Cl|MOD}} 8 <> 0 {{Cl|THEN}}
   ZeroPAD$ = {{Cl|SPACE$}}((8 - Picture{{Cl|WIDTH}}& {{Cl|MOD}} 8) \ 2)
+
   ZeroPAD$ = {{Cl|SPACE$}}((8 - PictureWIDTH& {{Cl|MOD}} 8) \ 2)
 
{{Cl|END IF}}
 
{{Cl|END IF}}
  
ImageSIZE& = (((Picture{{Cl|WIDTH}}& + {{Cl|LEN}}(ZeroPAD$)) * PictureDEPTH&) + .1) / 2
+
ImageSIZE& = (((PictureWIDTH& + {{Cl|LEN}}(ZeroPAD$)) * PictureDEPTH&) + .1) / 2
 
FileSize& = ImageSIZE& + OffsetBITS&
 
FileSize& = ImageSIZE& + OffsetBITS&
 
    
 
    
 
{{Cl|OUT}} {{Cl|&H}}3C7, 0                    'start at color 0
 
{{Cl|OUT}} {{Cl|&H}}3C7, 0                    'start at color 0
 
{{Cl|FOR}} n = 1 {{Cl|TO}} 48 {{Cl|STEP}} 3
 
{{Cl|FOR}} n = 1 {{Cl|TO}} 48 {{Cl|STEP}} 3
   File{{Cl|COLOR}}S%(n) = {{Cl|INP}}({{Cl|&H}}3C9)
+
   FileCOLORS%(n) = {{Cl|INP}}({{Cl|&H}}3C9)
   File{{Cl|COLOR}}S%(n + 1) = {{Cl|INP}}({{Cl|&H}}3C9)
+
   FileCOLORS%(n + 1) = {{Cl|INP}}({{Cl|&H}}3C9)
   File{{Cl|COLOR}}S%(n + 2) = {{Cl|INP}}({{Cl|&H}}3C9)
+
   FileCOLORS%(n + 2) = {{Cl|INP}}({{Cl|&H}}3C9)
 
{{Cl|NEXT}} n
 
{{Cl|NEXT}} n
  
 
{{Cl|OPEN}} Filename$ {{Cl|FOR (file statement)|FOR}} {{Cl|BINARY}} {{Cl|AS}} #1
 
{{Cl|OPEN}} Filename$ {{Cl|FOR (file statement)|FOR}} {{Cl|BINARY}} {{Cl|AS}} #1
 
                                   'Header bytes
 
                                   'Header bytes
{{Cl|PUT|PUT #}}1, , File{{Cl|TYPE}}$                  '2 '1 to 2
+
{{Cl|PUT|PUT #}}1, , FileTYPE$                  '2 '1 to 2
 
{{Cl|PUT|PUT #}}1, , FileSize&                  '4
 
{{Cl|PUT|PUT #}}1, , FileSize&                  '4
 
{{Cl|PUT|PUT #}}1, , Reserved1% 'should be zero  '2
 
{{Cl|PUT|PUT #}}1, , Reserved1% 'should be zero  '2
Line 194: Line 198:
 
{{Cl|PUT|PUT #}}1, , OffsetBITS&                '4
 
{{Cl|PUT|PUT #}}1, , OffsetBITS&                '4
 
{{Cl|PUT|PUT #}}1, , InfoHEADER&                '4
 
{{Cl|PUT|PUT #}}1, , InfoHEADER&                '4
{{Cl|PUT|PUT #}}1, , Picture{{Cl|WIDTH}}&              '4
+
{{Cl|PUT|PUT #}}1, , PictureWIDTH&              '4
 
{{Cl|PUT|PUT #}}1, , PictureDEPTH&              '4
 
{{Cl|PUT|PUT #}}1, , PictureDEPTH&              '4
 
{{Cl|PUT|PUT #}}1, , NumPLANES%                  '2
 
{{Cl|PUT|PUT #}}1, , NumPLANES%                  '2
Line 202: Line 206:
 
{{Cl|PUT|PUT #}}1, , WidthPELS&                  '4
 
{{Cl|PUT|PUT #}}1, , WidthPELS&                  '4
 
{{Cl|PUT|PUT #}}1, , DepthPELS&                  '4
 
{{Cl|PUT|PUT #}}1, , DepthPELS&                  '4
{{Cl|PUT|PUT #}}1, , Num{{Cl|COLOR}}S&                  '4
+
{{Cl|PUT|PUT #}}1, , NumCOLORS&                  '4
{{Cl|PUT|PUT #}}1, , Sig{{Cl|COLOR}}S&                  '4 '51 - 54
+
{{Cl|PUT|PUT #}}1, , SigCOLORS&                  '4 '51 - 54
  
 
u$ = " "            'unused byte
 
u$ = " "            'unused byte
 
{{Cl|FOR}} n% = 1 {{Cl|TO}} 46 {{Cl|STEP}} 3  '{{Cl|PUT (graphics statement)|PUT}} as BGR order colors
 
{{Cl|FOR}} n% = 1 {{Cl|TO}} 46 {{Cl|STEP}} 3  '{{Cl|PUT (graphics statement)|PUT}} as BGR order colors
   Colr$ = {{Cl|CHR$}}(File{{Cl|COLOR}}S%(n% + 2) * 4)
+
   Colr$ = {{Cl|CHR$}}(FileCOLORS%(n% + 2) * 4)
 
   {{Cl|PUT|PUT #}}1, , Colr$
 
   {{Cl|PUT|PUT #}}1, , Colr$
   Colr$ = {{Cl|CHR$}}(File{{Cl|COLOR}}S%(n% + 1) * 4)
+
   Colr$ = {{Cl|CHR$}}(FileCOLORS%(n% + 1) * 4)
 
   {{Cl|PUT|PUT #}}1, , Colr$
 
   {{Cl|PUT|PUT #}}1, , Colr$
   Colr$ = {{Cl|CHR$}}(File{{Cl|COLOR}}S%(n%) * 4)
+
   Colr$ = {{Cl|CHR$}}(FileCOLORS%(n%) * 4)
 
   {{Cl|PUT|PUT #}}1, , Colr$
 
   {{Cl|PUT|PUT #}}1, , Colr$
 
   {{Cl|PUT|PUT #}}1, , u$ 'add Unused byte
 
   {{Cl|PUT|PUT #}}1, , u$ 'add Unused byte
Line 230: Line 234:
  
 
{{Cl|FOR}} n = 0 {{Cl|TO}} 15
 
{{Cl|FOR}} n = 0 {{Cl|TO}} 15
   {{Cl|IF}} Colors4%(n) = 1 {{Cl|THEN}} Sig{{Cl|COLOR}}S& = Sig{{Cl|COLOR}}S& + 1
+
   {{Cl|IF}} Colors4%(n) = 1 {{Cl|THEN}} SigCOLORS& = SigCOLORS& + 1
 
{{Cl|NEXT}} n
 
{{Cl|NEXT}} n
{{Cl|PUT|PUT #}}1, 51, Sig{{Cl|COLOR}}S&       'new {{Cl|PUT (graphics statement)|PUT}}
+
{{Cl|PUT|PUT #}}1, 51, SigCOLORS&    
  
 
{{Cl|CLOSE}} #1
 
{{Cl|CLOSE}} #1
Line 240: Line 244:
 
{{CodeEnd}}
 
{{CodeEnd}}
 
<center>'''If full code is not displayed, refresh your browser!'''</center>
 
<center>'''If full code is not displayed, refresh your browser!'''</center>
 +
 +
  
 
''See also:''
 
''See also:''

Revision as of 19:13, 16 August 2010

Creating Screenshot Bitmaps inside of your Programs"


Syntax: EightBit Minimum_Column%, Minimum_Row%, Maximum_Column%, Maximum_Row%, NewFileName$


  • The values of x1%, y%1, x2% and y2% can be any ON SCREEN area coordinates in the screen mode used.
  • You MUST subtract one from x2% and y2% when using the QB64 FULL SCREEN _WIDTH and _HEIGHT values! Otherwise POINT may return an Illegal function error! The maximum is one pixel less than the SCREEN resolution or the _NEWIMAGE dimensions.
  • Coordinate values cannot be off of the screen!
  • Can create QB64 screenshots of _NEWIMAGE screen pages.
  • Can also copy images loaded using the _LOADIMAGE function.
  • Both SUBs can be used in QB64 or Qbasic! The FourBit SUB takes about 8 seconds in QB.
  • FourBit SUB creates 4 BPP(16 color) and EightBit SUB creates 8 BPP(256 color) bitmaps.


'----------------- Freeware by Bob Seguin 2003 -- (TheBOB) --------------------------| '| | '| ---- Decreased POINT time of 4 bit fullscreen to 8 seconds in Qbasic ---- | '| by Ted Weissgerber July, 2008 | '| - Add a special keypress to a game program to create a Screenshot - | '| | '--------------------------------- DEMO CODE ----------------------------------------- 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 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 'elapsed times valid for QB only 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(256 color) bitmap maker 'NOTE: Adjust x2% = 319 and y2% = 199 for legal POINTs when fullscreen in SCREEN 13 DIM FileCOLORS%(1 TO 768) DIM Colors8%(255) IF x1% > x2% THEN SWAP x1%, x2% IF y1% > y2% THEN SWAP y1%, y2% 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

SUB FourBIT (x1%, y1%, x2%, y2%, Filename$) SCREEN 12(16 color) bitmap maker 'fullscreen takes about 8 seconds in QB 'NOTE: Adjust x2% = 639 and y2% = 479 for legal POINTs when fullscreen in SCREEN 12 DIM FileCOLORS%(1 TO 48) DIM Colors4%(0 TO 15) IF x1% > x2% THEN SWAP x1%, x2% IF y1% > y2% THEN SWAP y1%, y2% 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& CLOSE #1 BEEP 'optional sound if available for 4 bit only END SUB

If full code is not displayed, refresh your browser!


See also:



Navigation:
Go to Keyword Reference - Alphabetical
Go to Keyword Reference - By usage
Go to Main WIKI Page