Difference between revisions of "Program ScreenShots"

From QB64 Wiki
Jump to navigation Jump to search
imported>Clippy
m
imported>Clippy
m
Line 8: Line 8:
 
* You MUST subtract one when using the '''QB64'''  FULL SCREEN [[_WIDTH]] and [[_HEIGHT]] values! Otherwise [[POINT]] will return an [[ERROR Codes|Illegal function error]]! The maximum is one pixel less than the [[SCREEN (statement)| SCREEN]] resolution or the [[_NEWIMAGE]] screen dimensions.
 
* You MUST subtract one when using the '''QB64'''  FULL SCREEN [[_WIDTH]] and [[_HEIGHT]] values! Otherwise [[POINT]] will return an [[ERROR Codes|Illegal function error]]! The maximum is one pixel less than the [[SCREEN (statement)| SCREEN]] resolution or the [[_NEWIMAGE]] screen dimensions.
 
* Coordinate values cannot be off of the screen!
 
* Coordinate values cannot be off of the screen!
* Can create QB64 screenshots of [[_NEWIMAGE]] screen pages.
+
* Can create QB64 screenshots of [[_NEWIMAGE]] screen pages or copy images loaded using [[_LOADIMAGE]].
* Can also copy images loaded using the [[_LOADIMAGE]] function.
 
 
* 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.

Revision as of 19:26, 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 when using the QB64 FULL SCREEN _WIDTH and _HEIGHT values! Otherwise POINT will return an Illegal function error! The maximum is one pixel less than the SCREEN resolution or the _NEWIMAGE screen dimensions.
  • Coordinate values cannot be off of the screen!
  • Can create QB64 screenshots of _NEWIMAGE screen pages or copy images loaded using _LOADIMAGE.
  • 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