Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : NN0505.ZIP
Filename : SCRNCAPT.PRG

#include "SET.ch"

PROCEDURE Scrn2Txt( cProc, nLine, cVar )
/***
* Program ID: ScrnCapt.prg
* Author: Orlando M. Chacon
* Date: 03/21/91
*
* Purpose: Captures the current screen to a text file.
* Resulting text file is uniquely named SCRNXXXX.TXT,
* where XXXX denotes invocation number.
*/

STATIC nFileNum := 0

LOCAL aScrnRows := ARRAY( MAXROW() + 1 )
LOCAL cFileName := "SCRN" + ;
PADL( ALLTRIM( STR( ++nFileNum ) ), 4, "0" ) +;
".TXT"
LOCAL nRow := 0

// Preserve Global settings
LOCAL lLastConsole := SET( _SET_CONSOLE , .F. )
LOCAL cLastPrintFile := SET( _SET_PRINTFILE, cFileName )
LOCAL cLastDevice := SET( _SET_DEVICE , "PRINT" )

// Read contents of current screen into an array (one row per element),
// stripping out color attribute characters with each iteration.
// Also, printing the current row to a file.
FOR nRow := 0 TO MAXROW()
aScrnRows[ nRow + 1 ] := ;
StripAttrib( SAVESCREEN( nRow, 0, nRow, MAXCOL() ) )
@ nRow+1, 01 SAY aScrnRows[ nRow + 1 ]
NEXT

// Restore Global settings
SET( _SET_DEVICE, cLastDevice )
SET( _SET_CONSOLE, lLastConsole )
SET( _SET_PRINTFILE, cLastPrintFile )

RETURN

STATIC FUNCTION StripAttrib( cScreenRow )
/***
* Removes color attribute characters which appear in strings
* derived from the SAVESCREEN() function.
*
*/
LOCAL cBuffer := cScreenRow
LOCAL nStringWidth := LEN( cBuffer )
LOCAL cStrippedRow := ""
LOCAL nColPos := 1

// Read every other character beginning with character 1 into
// a string, thereby dropping the color attribute characters.

FOR nColPos := 1 TO nStringWidth STEP 2
cStrippedRow += SUBSTR( cBuffer, nColPos, 1)
NEXT

RETURN( cStrippedRow )

FUNCTION InkeyCheck(nSeconds)
/***
* Smart Inkey():
* Checks to see if the key fetched from the keyboard buffer,
* during a wait state, has been assigned to a procedure using
* a SET KEY assignment. If so, the respective block/procedure
* is invoked.
*/

LOCAL nWait := IF( nSeconds == NIL, 0, nSeconds )
LOCAL nKey := INKEY( nWait )
LOCAL bKeyBlock := SETKEY( nKey )

IF bKeyBlock # NIL
EVAL( bKeyBlock, PROCNAME(2), PROCLINE(2), READVAR() )
ENDIF

RETURN(nKey)

// EOF: ScrnCapt.prg