'=========================================================================== ' Subject: BSAVE SCREEN CAPTURE TSR Date: Year of 1993 ' Author: Walt Mayo Code: PB ' Origin: FidoNet QUIK_BAS Echo Packet: PB.ABC '=========================================================================== '*********************************************************************** '* PopUp .BSV Screen Capture Routine '* Walt Mayo 1993, 1:3627/101 DATA:803-650-8315 VOICE:803-650-0140 '* PowerBasic 3.0 '* This file seems to work great in most situations. '* It does need some error-trapping added for existing files, so beware. '* ********************************************************************* $COMPILE EXE ' this tells PB to make a standalone EXE $LIB IPRINT OFF ' allow graphic characters to print $OPTION CNTLBREAK OFF ' not wise in a tsr x& = SETMEM(-700000) ' release unused memory POPUP KEY CHR$(8,30,247) ' ALT A is the hot key POPUP MULTIPLEX &HC000, 254 ' reg AX and DX get this pattern as an ID REG 1, &HC000 : REG 4, 254 ' set pattern to check for already installed CALL INTERRUPT &H2F ' do the multiplex interrrupt IF REG(1)<>&HC000 AND REG(4)<>254 THEN END 'we were already installed SwapFile$ = LEFT$(CURDIR$,2)+"\ASCTSR.SWP" PRINT "PopUp .BSV grabber available as ALT-A" REG 1, &HC001 : REG 4, 252 ' Alter AX,DX to show we were here POPUP SLEEP USING EMS, SwapFile$ ' before going to sleep WHILE 1=1 x% = POS : y% = CSRLIN DEF SEG = &hB800 SaveScreen$ = PEEK$(0,4000) ' save the entire screen IF REG(1)=&HC000 AND REG(4)=254 THEN LOCATE 12,20 PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; LOCATE 13,20 PRINT "³ BSVGRAB is already installed ³"; LOCATE 14,20 PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"; ELSE GOSUB GrabBSV END IF a$ = INPUT$(1) 'wait for key to cancel POKE$ 0, SaveScreen$ : LOCATE y%, x% 'restore screen IF UCASE$(A$)="Q" THEN IF POPUP(1) THEN END 'this uninstalls us REG 1, &HC001 : REG 4, 252 ' Alter AX,DX to show we were here POPUP SLEEP ' before going to sleep WEND GrabBSV: DEF SEG = &HB800 BSAVE "c:\zdir\axax.bsv", 0, 4000 LOCATE 1, 1 COLOR 14, 2 PRINT " "; LOCATE 1, 1 INPUT " Enter desired name for file: ", NewName$ NAME "c:\zdir\axax.bsv" as "c:\zdir\" + NewName$ LOCATE 1, 1 COLOR 15, 3 PRINT " Press Q to remove BSVGRAB, any other key to continue " 'DEF SEG RETURN