BCX Console Demonstration Program s90.bas
|
'-----------------------------------------------------------------
' BCX Console mode demonstration by Kevin Diggins (2000)
' Uses pointer arithmetic to grab screen text and color attributes
' Clears the screen and then restores the original text screen
'-----------------------------------------------------------------
DIM Buffer$ * (80 * 25 * 2) + 1
GetText(1, 1, 80, 24, Buffer$)
Say("Press a key to Clear the screen")
CLS
Say("Press a key to Restore the screen")
PutText (1, 1, 80, 24, Buffer$)
SUB Say(A$)
LOCAL EatKey
PRINT A$
WHILE NOT INSTAT
WEND
EatKey = KEYPRESS
END SUB
SUB GetText(x1, y1, x2, y2, dest$)
LOCAL i AS DWORD
LOCAL ilen AS DWORD
LOCAL width AS DWORD
LOCAL coord AS COORD
LOCAL pwattr AS LPWORD
LOCAL y AS INTEGER
LOCAL pstr AS LPSTR
width = (x2 - x1 + 1)
pwattr = (ushort *)malloc(width * SIZEOF(*pwattr) + 1)
IF NOT pwattr THEN
EXIT SUB
END IF
pstr = (char *)malloc(width)
IF NOT pstr THEN
EXIT SUB
END IF
FOR y = y1 TO y2
coord.X = x1 - 1
coord.Y = y - 1
ReadConsoleOutputCharacterA(hConsole, pstr, width, coord, &ilen)
ReadConsoleOutputAttribute(hConsole, pwattr, width, coord, &ilen)
FOR i = 0 TO width
*dest$ = *(pstr + i)
dest++
*dest$ = (char)*(pwattr + i)
dest++
NEXT
NEXT
END SUB
SUB PutText(x1, y1, x2, y2, srce$)
LOCAL i AS DWORD
LOCAL ilen AS DWORD
LOCAL width AS DWORD
LOCAL coord AS COORD
LOCAL pwattr AS LPWORD
LOCAL y AS INTEGER
LOCAL pstr AS LPSTR
width = (x2 - x1 + 1)
pwattr = (ushort *)malloc(width * SIZEOF(*pwattr))
IF NOT pwattr THEN
EXIT SUB
END IF
pstr = (char *)malloc(width + 1)
IF NOT pstr THEN
EXIT SUB
END IF
FOR y = y1 TO y2
FOR i = 0 TO width
*(pstr + i) = *srce$
srce++
*(pwattr + i) = *srce$
srce++
NEXT i
coord.X = x1 - 1
coord.Y = y - 1
WriteConsoleOutputCharacterA(hConsole, pstr, width, coord, &ilen)
WriteConsoleOutputAttribute(hConsole, pwattr, width, coord, &ilen)
NEXT y
END SUB