Difference between revisions of "Program ScreenShots"

From QB64 Wiki
Jump to navigation Jump to search
imported>Clippy
m
imported>Clippy
m
Line 64: Line 64:
 
{{Cl|DIM}} FileCOLORS%(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}} y1% > y2% {{Cl|THEN}} {{Cl|SWAP}} y1%, y2%
 
{{Cl|IF}} {{Cl|INSTR}}(Filename$, ".BMP") = 0 {{Cl|THEN}}
 
{{Cl|IF}} {{Cl|INSTR}}(Filename$, ".BMP") = 0 {{Cl|THEN}}
 
Filename$ = {{Cl|RTRIM$}}({{Cl|LEFT$}}(Filename$, 8)) + ".BMP"
 
Filename$ = {{Cl|RTRIM$}}({{Cl|LEFT$}}(Filename$, 8)) + ".BMP"
Line 74: Line 75:
 
OffsetBITS& = 1078
 
OffsetBITS& = 1078
 
InfoHEADER& = 40
 
InfoHEADER& = 40
PictureWIDTH& = {{Cl|ABS}}(x2% - x1%) + 1
+
PictureWIDTH& = (x2% - x1%) + 1
PictureDEPTH& = {{Cl|ABS}}(y2% - y1%) + 1
+
PictureDEPTH& = (y2% - y1%) + 1
 
NumPLANES% = 1
 
NumPLANES% = 1
 
BPP% = 8
 
BPP% = 8
Line 151: Line 152:
 
{{Cl|DIM}} FileCOLORS%(1 {{Cl|TO}} 48)
 
{{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}} y1% > y2% {{Cl|THEN}} {{Cl|SWAP}} y1%, y2%
 
{{Cl|IF}} {{Cl|INSTR}}(Filename$, ".BMP") = 0 {{Cl|THEN}}
 
{{Cl|IF}} {{Cl|INSTR}}(Filename$, ".BMP") = 0 {{Cl|THEN}}
 
     Filename$ = {{Cl|RTRIM$}}({{Cl|LEFT$}}(Filename$, 8)) + ".BMP"
 
     Filename$ = {{Cl|RTRIM$}}({{Cl|LEFT$}}(Filename$, 8)) + ".BMP"
Line 161: Line 163:
 
OffsetBITS& = 118
 
OffsetBITS& = 118
 
InfoHEADER& = 40
 
InfoHEADER& = 40
PictureWIDTH& = {{Cl|ABS}}(x2% - x1%) + 1
+
PictureWIDTH& = (x2% - x1%) + 1
PictureDEPTH& = {{Cl|ABS}}(y2% - y1%) + 1
+
PictureDEPTH& = (y2% - y1%) + 1
 
NumPLANES% = 1
 
NumPLANES% = 1
 
BPP% = 4
 
BPP% = 4

Revision as of 16:06, 2 October 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 screen dimensions.
  • 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.


QB64 Custom Screens
  • See the ThirtyTwoBit SUB routine to create QB64 screenshots of _NEWIMAGE screen pages or copy images loaded using _LOADIMAGE. Creates 256 or 24/32 bit color bitmaps using the QB64 image and page handles.


'----------------- 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& AND 3) THEN ZeroPAD$ = SPACE$(4 - (x& AND 3)) 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 Examples:

  • SAVEIMAGE (QB64 full screen Image to Bitmap SUB by Galleon)


See also:




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