Screen 0 Dumper - More code!

[Patz QuickBASIC Creations]

This is a screen dump routine for screen 0. It might work for other screen modes, but I haven't tried. It copies every letter, foreground, and background displayed on the screen. File sizes vary on screen width and height (duh.)



To dump the screen into a file:

Code: Select all

ON ERROR RESUME NEXT

DIM Temp AS STRING * 1

Wdth% = 1
Height% = 1

DO
 LOCATE , Wdth%
 IF ERR THEN EXIT DO
 Wdth% = Wdth% + 1
LOOP
Wdth% = Wdth% - 1

ERR = 0

DO
 LOCATE Height%
 IF ERR THEN EXIT DO
 Height% = Height% + 1
LOOP

Height% = Height% - 1

DIM TextData%(Height%, Wdth%)
DIM ColorData%(Height%, Wdth%)

FOR A = 1 TO Height%
FOR B = 1 TO Wdth%
TextData%(A, B) = SCREEN(A, B)
ColorData%(A, B) = SCREEN(A, B, 1)
NEXT B
NEXT A

INPUT "Save to: ", File$
OPEN File$ FOR BINARY ACCESS WRITE AS #255

Tag$ = "PQBC-SCR0DUMP-V0.1"
FOR A = 1 TO LEN(Tag$)
 Temp = MID$(Tag$, A, 1)
 PUT #255, , Temp
NEXT A

Temp = CHR$(Height%)
PUT #255, , Temp

Temp = CHR$(Wdth%)
PUT #255, , Temp

FOR A = 1 TO Height%
 FOR B = 1 TO Wdth%
  Temp = CHR$(ColorData%(A, B))
  PUT #255, , Temp
  Temp = CHR$(TextData%(A, B))
  PUT #255, , Temp
 NEXT B
NEXT A

CLOSE #255

To display the contents of a file from the program above:

Code: Select all

DIM Temp AS STRING * 1
PRINT "PQBC Screen 0 Dump - V0.1"
INPUT " File to display? ", Display$

OPEN Display$ FOR BINARY ACCESS READ AS #255

FOR A = 1 TO 18
 GET #255, , Temp
 PrelimString$ = PrelimString$ + Temp
NEXT A

IF PrelimString$ <> "PQBC-SCR0DUMP-V0.1" THEN
 PRINT Display$; " is not a PQBC Screen Dump file."
 CLOSE #255
 SYSTEM
END IF

GET #255, , Temp
Height% = ASC(Temp)
GET #255, , Temp
Wdth% = ASC(Temp)

WIDTH Wdth%, Height%

CLS

FOR A = 1 TO Height% - 2
 FOR B = 1 TO Wdth%
  GET #255, , Temp
  Fore% = ASC(Temp) MOD 16
  Back% = INT(ASC(Temp) / 16)
  COLOR Fore%, Back%
  GET #255, , Temp
  LOCATE A, B
  PRINT Temp
 NEXT B
NEXT A

CLOSE #255

Improvements? I have been bored this weekend, in case you didn't see my base conversion codes...

[bungytheworm]

There is ways to do it differently, but yours is cool too.
Im working with library that has that function too. First func. SCREENSIZE gives values of width and hight to integers, then i dim array copiedscreen(width, hight, 3). 3 since there is character value, fore- and background colors.
SCREENCOPY(array()) stores current screen on array()
RESTORESCREEN(array()) returns it.

So basixly, it goes like this.

Code: Select all

Dim AS Integer rows, cols
SCREENSIZE rows, cols 
DIM AS Integer CurrentScreen(rows, cols, 3)
COPYSCREEN(CurrentScreen()) ' copies from screen. works only with ASCII chars.

CLS
RESTORESCREEN(CurrentScreen()) ' returns it back there