'=========================================================================== ' Subject: COPY TEXT SCREEN FOR PBCC Date: 04-16-00 (20:49) ' Author: Jerry Fielden Code: PBCC ' Origin: fielden@pldi.net Packet: PBCC.ABC '=========================================================================== '---------------------------------------------------------- ' Author: Jerry Fielden Date: 2000 | ' | '---------------------------------------------------------- ' These SUBS are for PBCC. They copy Text screens and | ' put them back in same or different locations with its | ' original colors | '---------------------------------------------------------- DECLARE SUB TextPutz (R1&, C1&, R2&, C2&, Area$(), TxClr$()) DECLARE SUB TextGetz (R1&, C1&, R2&, C2&, Area$(), TxClr$()) DECLARE SUB MakeBox() DECLARE SUB LoadFmFile (Area$(), TxClr$(), TotalChar&, FileNames$) DECLARE SUB SaveToFile (Area$(), TxClr$(), TotalChar&, FileNames$) FUNCTION PBMAIN() DIM TxClr$(2000) : DIM Area$(2000) MakeBox '.....................Call the box maker SLEEP 500 R1& = 1 '......................Starting row C1& = 1 '......................Starting column r2& = 6 '......................Ending row c2& = 16 '.....................Ending column TextGetz R1&, C1&, R2&, C2&, Area$(),TxClr$() 'put it in arrays TextPutz 1, 34, 6, 49, Area$(), TxClr$() 'put it on the screen SLEEP 500 '--------------- Put it into a file and load it back -------------- FileNames$ = "Area96.BNY" ' Give it a name TotalChar& = 96 ' Chars in area SaveToFile Area$(), TxClr$(), TotalChar&, FileNames$ ' Save it RESET Area$() : RESET TxClr$()'..........................Clear Arrays LoadFmFile Area$(), TxClr$(), TotalChar&, FileNames$ ' Load it back '---------------------- Paste it at the bottom of screen --------- TextPutz 20, 34, 25, 49, Area$(), TxClr$() SLEEP 500 '-------------------- Move it around ---------------- C1& = 1 : c2& = 16 FOR R1& = 1 TO 24 STEP 6 r2& = r1& + 5 TextPutz R1&, C1&, R2&, C2&, Area$(), TxClr$() C1& = C1& + 17 c2& = c2& + 17 SLEEP 500 NEXT R1& SLEEP 2000 '--- Copying Full Screen, saving it in a file and loading it back TextGetz 1, 1, 25, 80, Area$(),TxClr$() ' Copy full screen FileNames$ = "Full2080.BNY" ' Give it a name TotalChar& = 2000 ' Chars in screen SaveToFile Area$(), TxClr$(), TotalChar&, FileNames$ ' Save it COLOR 7, 0 RESET Area$() : RESET TxClr$() : CLS 'Clear Arrays & screen LOCATE 12, 1 PRINT " Loading Full Screen from File and here it is " SLEEP 3000 LoadFmFile Area$(), TxClr$(), TotalChar&, FileNames$ ' Load it back TextPutz 1, 1, 25, 80, Area$(), TxClr$() ' Put it on Screen SLEEP 5000 COLOR 7, 0 CLS KILL "Full2080.BNY" KILL "AREA96.bny" '.........Get rid of temp files END FUNCTION '-------------------------------------------------------------------- ' TextGetz will copy any portion of the screen, even full | ' screen into Arrays | '---------------------------------------------------------- SUB TextGetz (R1&, C1&, R2&, C2&, Area$(), TxClr$()) row& = R1&: col& = c1& RESET Area$() : RESET TxClr$()'....Clear from last time Wide& = C2& - C1& + 1'.............get columns wide Tall& = R2& - R1&'.................get rows tall FOR x& = 1 TO Tall& + 1 FOR y& = 1 TO Wide& INCR nbr& TxClr$(nbr&) = CHR$(SCREENATTR(row&, col&))'..Read in color Area$(nbr&) = CHR$(SCREEN(row&, col&))'.......Read in a char. INCR Col&'............................Setup to do another char. NEXT y& col& = c1&'............................Setup column for next row INCR Row&'.................................Setup to do next row NEXT x& END SUB '--------------------------------------------------------------------- ' TextPutz will put screen portions back in different | ' locations if needed. Portions can be obtained by using | ' SUBs, TextGetz or LoadFmFile. TextPutz uses PCOPY AND | ' PAGE to speed up for standard SCREEN modes Printing | '------------------------------------------------------------ SUB TextPutz (R1&, C1&, R2&, C2&, Area$(), TxClr$()) Col& = C1& : Row& = R1& ' Get start column & row Wide& = C2& - C1& + 1 ' How wide is it Tall& = R2& - R1& ' How tall is it PCOPY 1, 2 : PAGE 2, 1 ' FOR x& = 1 TO Tall& + 1 ' Do the rows FOR y& = 1 TO wide& ' Do the columns INCR nbr& ForGnd& = ASC(TxClr$(nbr&)) MOD 16& 'Get Forground color BackGnd& = ASC(TxClr$(nbr&)) \ 16& 'Get Background color COLOR ForGnd&, BackGnd& 'Change the colors LOCATE row&, Col& PRINT Area$(nbr&); ' Print a charecter INCR col& ' Moving to next column NEXT y& col& = c1& : INCR row& ' Get start column & next row NEXT x& PCOPY 2, 1 : PAGE 1, 1 ' Make it visable END SUB '---------------------------------------------------------------------- ' SaveToFile saves Full Screen or portions that | ' was acquired by TextGetz to a binary file which | ' is also compatible with PBDOS POKE$ statements | '--------------------------------------------------- SUB SaveToFile (Area$(), TxClr$(), TotalChar&, FileNames$) OPEN FileNames$ FOR BINARY AS #1'....Put it in a file FOR x& = 1 TO TotalChar& PUT$ #1, Area$(x&)'...........Save 1 char of area PUT$ #1, TxClr$(x&)'..........Save it's colors NEXT x& '..........Do it again CLOSE #1 END SUB '--------------------------------------------------------------------- ' LoadFmFile will Load a binary file into ARRAYs | ' that can be used BY TextPutz to put on the screen. | ' The file has to have alternating string charecters | ' that represents color attributes like those that DOS | ' PB POKE$ uses. | '------------------------------------------------------- SUB LoadFmFile (Area$(), TxClr$(), TotalChar&, FileNames$) OPEN FileNames$ FOR BINARY AS #1 FOR x& = 1 TO TotalChar& GET$ #1, 1, Area$(x&)'...........get 1 char GET$ #1, 1, TxClr$(x&)'..........get 1 color attribute NEXT x&'...........................Go Do it again CLOSE #1 END SUB '---------------------------------------------------------- SUB MakeBox() PCOPY 1, 2 : PAGE 2, 1 COLOR 1, 11 FOR r& = 1 TO 25 'fill screen with chars . FOR c& = 1 TO 80 PRINT CHR$(176); NEXT c& NEXT r& COLOR 14, 1 : LOCATE 1, 1 'make a box PRINT CHR$(201, 205, 205, 205, 205, 205, 205, 205, 205, _ 205, 205, 205, 205, 205, 205, 187) PRINT CHR$(186) + " This is an " + CHR$(186) PRINT CHR$(186) + " Example of " + CHR$(186) COLOR 11, 4 PRINT CHR$(186) + " Screen parts " + CHR$(186) PRINT CHR$(186) + " Copy & Save " + CHR$(186) PRINT CHR$(200, 205, 205, 205, 205, 205, 205, 205, 205, _ 205, 205, 205, 205, 205, 205, 188) PCOPY 2, 1 : PAGE 1, 1 END SUB