Program ScreenShots

From QB64 Phoenix Edition Wiki
Jump to navigation Jump to search
Attention!! - This page is outdated and provided for reference and/or education only.
(Return to historic Table of Contents)
Starting with QB64-PE v3.9.0 the functionality described here was superseded by _SAVEIMAGE.


Creating Screenshot Bitmaps inside of your Programs


Syntax

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


Description

  • 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.


Examples


'----------------- 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 -----------------------------------------

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
f% = FREEFILE
OPEN Filename$ FOR BINARY AS #f%

PUT #f%, , FileTYPE$
PUT #f%, , FileSize&
PUT #f%, , Reserved1% 'should be zero
PUT #f%, , Reserved2% 'should be zero
PUT #f%, , OffsetBITS&
PUT #f%, , InfoHEADER&
PUT #f%, , PictureWIDTH&
PUT #f%, , PictureDEPTH&
PUT #f%, , NumPLANES%
PUT #f%, , BPP%
PUT #f%, , Compression&
PUT #f%, , ImageSIZE&
PUT #f%, , WidthPELS&
PUT #f%, , DepthPELS&
PUT #f%, , NumCOLORS&
PUT #f%, , SigCOLORS&     '51 to 54

u$ = " "
FOR n% = 1 TO 768 STEP 3  'PUT as BGR order colors
  Colr$ = CHR$(FileCOLORS%(n% + 2) * 4)
  PUT #f%, , Colr$
  Colr$ = CHR$(FileCOLORS%(n% + 1) * 4)
  PUT #f%, , Colr$
  Colr$ = CHR$(FileCOLORS%(n%) * 4)
  PUT #f%, , Colr$
  PUT #f%, , 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 #f%, , a$
  NEXT x
  PUT #f%, , ZeroPAD$
NEXT y

FOR n = 0 TO 255
  IF Colors8%(n) = 1 THEN SigCOLORS& = SigCOLORS& + 1
NEXT n

PUT #f%, 51, SigCOLORS&
CLOSE #f%
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
f% = FREEFILE
OPEN Filename$ FOR BINARY AS #f%
                                   'Header bytes
PUT #f%, , FileTYPE$                   '2 '1 to 2
PUT #f%, , FileSize&                   '4
PUT #f%, , Reserved1% 'should be zero  '2
PUT #f%, , Reserved2% 'should be zero  '2
PUT #f%, , OffsetBITS&                 '4
PUT #f%, , InfoHEADER&                 '4
PUT #f%, , PictureWIDTH&               '4
PUT #f%, , PictureDEPTH&               '4
PUT #f%, , NumPLANES%                  '2
PUT #f%, , BPP%                        '2
PUT #f%, , Compression&                '4
PUT #f%, , ImageSIZE&                  '4
PUT #f%, , WidthPELS&                  '4
PUT #f%, , DepthPELS&                  '4
PUT #f%, , NumCOLORS&                  '4
PUT #f%, , 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 #f%, , Colr$
  Colr$ = CHR$(FileCOLORS%(n% + 1) * 4)
  PUT #f%, , Colr$
  Colr$ = CHR$(FileCOLORS%(n%) * 4)
  PUT #f%, , Colr$
  PUT #f, , 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 #f%, , a$
  NEXT x
  PUT #f%, , ZeroPAD$
NEXT y

FOR n = 0 TO 15
  IF Colors4%(n) = 1 THEN SigCOLORS& = SigCOLORS& + 1
NEXT n
PUT #f%, 51, SigCOLORS&

CLOSE #f%
'BEEP         'optional sound not needed in QB64 as speed is fast
END SUB

More Examples


See also


QB64 Programming References

Wiki Pages
Main Page with Articles and Tutorials
QB64 specific keywords (alphabetical)
Original QBasic keywords (alphabetical)
QB64 OpenGL keywords (alphabetical)
Keywords by Usage
Got a question about something?
Frequently Asked Questions about QB64
QB64 Phoenix Edition Community Forum
Links to other QBasic Sites:
Pete's QBasic Forum
Pete's QBasic Downloads
Retrieved from "https://qb64phoenix.com/qb64wiki/index.php?title=Program_ScreenShots&oldid=9258"