Graphics Screen

 BBS: Inland Empire Archive
Date: 07-28-92 (21:55)             Number: 98
From: MATT HART                    Refer#: NONE
  To: MARK KO                       Recvd: NO  
Subj: Graphics Screen                Conf: (2) Quik_Bas

 MK> Does anyone know how to save the graphics screen for 640x480x16, VGA?
 MK> Also, using a binary file?"BSAVE", not a text file...

'
' GSAVES.BAS  by Matt Hart
' Save/Restore multiple graphics screens in
' any mode to a single file.
'
' Compile with /AH for huge arrays and
' /X for error trapping with RESUME NEXT
'
' The data is stored as follows:
'   1 Byte  :  Monitor Type
'   1 Byte  :  Screen Mode (0-13)
'   For VGA monitors, the palette (long integers)
'   is stored next for screens 11, 12, and 13
'
'    Screen Mode   Number of Bytes   Number of Attributes
'       11               8                   2
'       12              64                  16
'       13            1024                 256
'
    DEFINT A-Z
    DECLARE FUNCTION CalcBytes&(X,Y,BPP,P)
    TYPE RegTypeX
        ax    AS INTEGER

        bx    AS INTEGER
        cx    AS INTEGER
        dx    AS INTEGER
        bp    AS INTEGER
        si    AS INTEGER
        di    AS INTEGER
        flags AS INTEGER
        ds    AS INTEGER
        es    AS INTEGER
    END TYPE
    '
    CONST False = 0
    CONST True  = NOT False
    '
    ON ERROR GOTO ErrorTrap
    '
    REDIM NumBytes&(0 TO 13)
    NumBytes&(0)  = 4000&
    NumBytes&(1)  = CalcBytes&(320,200,2,1)
    NumBytes&(2)  = CalcBytes&(640,200,1,1)
    NumBytes&(3)  = CalcBytes&(720,348,1,1)
    NumBytes&(7)  = CalcBytes&(320,200,1,4)
    NumBytes&(8)  = CalcBytes&(640,200,1,4)
    NumBytes&(9)  = CalcBytes&(640,350,1,4)
    NumBytes&(10) = CalcBytes&(640,350,1,2)
    NumBytes&(11) = CalcBytes&(640,480,1,1)
    NumBytes&(12) = CalcBytes&(640,480,1,4)
    NumBytes&(13) = CalcBytes&(320,200,8,1)
    '
    FileName$ = "SCREENS.BIN"
    ' Example 1 : Screen 0
    CLS : PRINT "This is Screen 0"
    COLOR 14 : PRINT "     This is Screen 0"
    Mon = 0 : ScrMode = 0 : ScreenNum = 1
    CALL SaveScreen(FileName$, Mon, ScrMode, ScreenNum, NumBytes&(), Ecode)
    CLS
    CALL RestoreScreen(FileName$, ScreenNum, NumBytes&(), Ecode)
    END
    ' Parameters are:
    '     FileName$  =  File to save the screen to
    '           Mon  =  Monitor Type
    '                     0 = Monochrome/Text Only
    '                     1 = Hercules
    '                     2 = CGA
    '                     3 = EGA
    '                     4 = VGA
    '       ScrMode  =  Current Screen Mode (0-13)
    '     ScreenNum  =  Screen Number to Save
    '                   Will return with the last screen
    '                   number in the file if ScreenNum
    '                   was greater than the last screen + 1
    '   NumBytes&()  =  Array containing the number of bytes
    '                   needed to save a screen
    '         Ecode  =  0 if no error, 1 if
    '                   ScreenNum already exists and
    '                   is not the same ScrMode and Mon,
    '                   or -1 if some other error.
    '
ErrorTrap:
    Ecode = True
    RESUME NEXT
    '
SUB SaveScreen(FileName$, Mon, ScrMode, ScreenNum, NumBytes&(), Ecode)
    Ecode = False
    Buf = FreeFile
    OPEN "B",Buf,FileName$ : IF Ecode THEN EXIT SUB
    CurScr = 1  :  CurPos& = 1
DO
    IF EOF(Buf) THEN EXIT DO
    M$=" " : S$=" " : GET Buf,,M$ : GET Buf,,S$
    M=ASC(M$) : S=ASC(S$) : CurPos& = CurPos& + 2
    IF CurScr = ScreenNum THEN
        IF M=Mon AND S=ScrMode THEN
            SEEK #Buf, CurPos& - 2
            EXIT DO
        ELSE
            Ecode = 1
            EXIT DO
        ENDIF
    ELSE
        IF M=4 THEN
            SELECT CASE S
                CASE 11 : CurPos& = CurPos& + 8&
                CASE 12 : CurPos& = CurPos& + 64&
                CASE 13 : CurPos& = CurPos& + 1024&
            END SELECT
        ENDIF
        CurPos& = CurPos& + NumBytes&(S)
        SEEK #Buf, CurPos&
        IF Ecode THEN EXIT DO       ' a DOS Error
        CurScr = CurScr + 1
    ENDIF
LOOP
    IF Ecode <> 0 THEN GOTO SS.Ending
    ScreenNum = CurScr
    A$=CHR$(Mon)+CHR$(ScrMode) : PUT #Buf,,A$
    IF Ecode THEN GOTO SS.Ending        ' DOS Error
    REDIM Saver&(1 TO NumBytes&(ScrMode))
    SaveSeg = VARSEG(Saver&(1))
    SaveAdd& = VARPTR(Saver&(1))
    SELECT CASE ScrMode
        CASE 0
            FOR P=0 TO 3999
                DEF SEG = &HB000 : Z=PEEK(P)
                DEF SEG = SaveSeg : POKE SaveAdd&+P,Z
            NEXT P
            DEF SEG
        CASE 1,7,13 : GET (0,0)-(319,199),Saver&
        CASE 2,8    : GET (0,0)-(639,199),Saver&
        CASE 3      : GET (0,0)-(719,347),Saver&
        CASE 9,10   : GET (0,0)-(639,349),Saver&
        CASE 11,12  : GET (0,0)-(639,479),Saver&
    END SELECT
    IF Ecode THEN GOTO SS.Ending        ' Wrong Screen mode probably
    IF Mon = 4 THEN
        SELECT CASE S
            CASE 11 : NumPal = 2
            CASE 12 : NumPal = 16
            CASE 13 : NumPal = 256
            CASE ELSE : NumPal = 0
        END SELECT
        IF NumPal > 0 THEN
            DIM InRegs AS RegTypeX