Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DBWIN.ZIP
Filename : TEST1.PRG
SET TALK OFF
SET BELL OFF
SET STATUS OFF
SET SCOREBOARD OFF
SET CONFIRM ON
LOAD DBWNWOAN
CLEAR
Store 1 to trow,lcol
Store 12 to btrow
Store 40 to rcol
Store 7 to wattr,battr
Store 2 to borcset
Store "S"+chr(trow)+chr(lcol)+chr(btrow)+chr(rcol)+chr(wattr)+;
chr(battr)+chr(borcset) to mstuff
STORE "S"+chr(1)+chr(41)+chr(12)+chr(80)+chr(7)+chr(112)+chr(4) to mstuffa
STORE "S"+chr(13)+chr(41)+chr(25)+chr(80)+chr(112)+chr(254)+chr(2) to mstuffb
STORE "S"+chr(13)+chr(1)+chr(25)+chr(40)+chr(50)+chr(7)+chr(3) to mstuffc
STORE "S"+chr(8)+chr(28)+chr(17)+chr(58)+chr(112)+chr(7)+chr(5);
+CHR(176)to mstuffd
CALL DBWNWOAN with mstuff
CALL DBWNWOAN with mstuffa
CALL DBWNWOAN with mstuffb
CALL DBWNWOAN with mstuffc
CALL DBWNWOAN with mstuffd
STORE 100 to mcounter
do while mcounter < 115
@ 11,30 Say "W I N D O W S for"
@ 13,35 SAY "d B A S E I I I +!"
STORE "S"+chr(8)+chr(28)+chr(17)+chr(58)+chr(122-mcounter)+chr(mcounter);
+chr(5)+CHR(176)to mstuffd
CALL DBWNWOAN with mstuffd
mcounter = mcounter + 1
enddo
STORE "?" TO something
STORE 1 TO mcounter,trow,lcol,borcset
Store 3 to btrow,rcol
store 7 to battr,wattr
store 176 to borchar
Do while mCounter < 9
STORE "S"+chr(trow)+chr(lcol)+chr(btrow)+chr(rcol)+chr(battr)+;
chr(wattr)+chr(borcset) TO mstuff
CALL Dbwnwoan WITH mstuff
mcounter = mcounter +1
trow = trow + 1
btrow = btrow + 2
lcol = lcol + mcounter
rcol = rcol + 2*mcounter
ENDDO
mcounter = 0
trow = 8
btrow = 19
lcol = 36
rcol = 73
DO WHILE mcounter <7
STORE "S"+chr(trow)+chr(lcol)+chr(btrow)+chr(rcol)+chr(7);
+chr(112)+chr(2) TO mstuff
CALL Dbwnwoan WITH mstuff
mcounter = mcounter + 1
trow = trow -1
lcol = lcol - 4
rcol = rcol - 1
btrow = btrow + 1
ENDDO
trow = trow +2
lcol = lcol +5
rcol = rcol - 1
btrow = btrow -2
mcounter = 1
store 70 to battr
Do while mcounter < 8
IF mcounter >4
STORE "S"+chr(trow)+chr(lcol)+chr(btrow)+chr(rcol)+chr(7)+chr(battr);
+chr(mcounter)+chr(mcounter-4) TO mstuff
Else
STORE "S"+chr(trow)+chr(lcol)+chr(btrow)+chr(rcol)+chr(7)+chr(battr);
+chr(mcounter) TO mstuff
ENDIF
CALL dbwnwoan with mstuff
mcounter = mcounter + 2
trow = trow + 2
lcol = lcol + 2
btrow = btrow -2
rcol = rcol -2
if battr = 70
store 112 to battr
Else
battr = 70
ENDIF
Enddo
STORE mstuff to mhold
@ 12,26 SAY "D B W I N D (1.1) D E M O"
DO WHILE .NOT. something $ "YyNn"
@ 15,21 SAY "Do you want instructions (Y/N)? "GET something
READ
ENDDO
IF something $ "Yy"
CLEAR
TEXT
-> '!' signifies stuff changed in this version. <-
This program demonstrates the way WNWOAN.BIN deals with screens.
It displays a fancy screen, then it prompts you for the coordinates of the
window you wish to open. Then it opens the window, makes a silly remark,
and waits for you to respond. When you do it shuts the window and restores
what was behind it.
In use, of course, the programmer would specify the location of the
window on the screen, passing a character string like:
! -> STORE "S"+chr(4)+chr(40)+chr(12)+chr(80) TO mparam
! -> CALL DBWIND with mparam
to open a small window on the upper right quarter of the screen.
For the purposes of the demo, choosing a window that will open smack
in the middle of the screen will perhaps be the most provocative. I have
suggested some values, as you will see
ENDTEXT
WAIT TO NOTHING
CLEAR
TEXT
! CGA users will notice a blink or flash. TO prevent snow DBWIND
disables the CGA while it reads from and writes to video memory. Kenneth
Getz in Savescr and Restscr uses the alternative technique of waiting for
the raster scanner to retrace before reading or writing video memory. Very
nice! ->> New version writes during retraces - no flash <<-
This is INTENDED to be able to cope with MGAs, CGAs, and EGAs. I could
only actually test it on a CGA. I would be very interested in how it works
for other video arrangements. Especially, if EGA users are seeing flashes,
then I musta goofed.
I wrote this using Norton Editor which seems really nice for this kinda
stuff. Also SYMDEB was indispensible - except that I had to ORG at 100H and
end with an INT 20H to deal be able to use all the little labels and such.
And the whole problem with where the segment registers are pointing only
occurs when you are actually calling the module from dBase, so there were
some surprises
The folks on the ASHFORUM on CIS and at the customer support number at
Ashton Tate were helpful and patient and only once did I get an answer to
a question I had no intention of asking!
ENDTEXT
WAIT TO nothing
CLEAR
TEXT
Just in case I have failed to make my point clear, the way
this demonstration uses DBWIND is NOT AT ALL the suggested way for using it.
I can scarcely imagine a situation arising where the programmer would want to
let the operator control the size and position of the window. It is far more
likely that the programmer would want to control those matters.
The Demo will let you enter numbers as high as 99, (Higher for
attributes and border characters) but will not accept numbers lower than 1.
DBase doesn't like to deal with CHR(0). If the difference between the
two row or the two column numbers is less than 2, WNWOAN will refuse
to function, but this program will continue, leading to boring results.
With a little tampering with the ASM file - specifically by
messing with all the lines referring to AWREADY - and making the necessary
consequential adjustments - you can make this thing redraw a screen twice.
You could open a window, close it, attempt an open with illegal parameters,
that is, ones which specify a window bigger than the screen or one where the
window is too small to open. Then you could Call DBWIND with an "R" and your
precious screen would be redrawn again. Lotsa possibilities here.....
! Some of which are realized in this version...
ENDTEXT
wait to nothing
CLEAR
TEXT
Modifications for Version 1.1:
Now the parameter is a lot longer and has the following specifications:
(These values are not necessarily trapped if wrong, they're just recommended.)
Char 1: SsRr Save (open window) or Restore (write from buffer)
Char 2: 1...24 Top Row
Char 3: 1...78 Left Column
Char 4: 2...25 Bottom Row
Char 5: 2...80 Right Column
Char 6: 1...255 Window Attribute
Char 7: 1...255 Border Attribute
----->> NOTE: Because dBase freaks out at a CHR(0), the first of the
256 possible attribute/color byte combinations is un-
available - So, sue me! Seriously, I regret this and
will address the whole issue of attribute/color at a
later date and version. FOR NOW, IT'S UP TO YOU TO
KEEP THE ATTRIBUTE BYTES REASONABLE <<< CAUTION !!!!!!
ENDTEXT
WAIT TO nothing
CLEAR
TEXT
Modifications for Version 1.1 (continued):
Char 8:1...5 Border Character Set
1. - Single Line
2. - Double Line
3. - Single Vertical/Double Horizontal
4. - Double Vertical/Single Horizontal
5 (or greater).
- Use the following Character as the border character
Char 9:1...255 (OPTIONAL) The programmer selected character
to be used as a border character - any ASCII
plus IBM character is possible. You don't want
a border? Use a space
-bute as the window attribute.....
Note the Important relationship between Character 8 and Character 9
ENDTEXT
WAIT TO nothing
ENDIF
CLEAR
*
Store "?" to mquitter
DO WHILE .NOT. mquitter $ "Yy"
CLEAR
@ 14,16 to 18,51 DOUBLE
@ 12,14 to 19,55
@ 10,12 to 20,59 DOUBLE
@ 8,10 to 21,63
@ 6,8 to 22,67 DOUBLE
@ 4,6 to 23,71
@ 2,4 to 24,75 DOUBLE
@ 2,11 CLEAR TO 2,68
@ 1,10 to 3, 69 DOUBLE
@ 2,21 say "Are you Ready for this or what" GET something
READ
Store .T. to merror
@ 2,21 say " Gimme a Top row (1-24) please" GET trow RANGE 1,99
READ
@ 2,21 say "Gimme a left column (1-79) please" GET lcol RANGE 1,99
READ
@ 2,21 say " Gimme a bottom row (2-25) please" GET btrow RANGE 1,99
READ
@ 2,21 say "Gimme a right column (2-80) please" GET rcol RANGE 1,99
READ
@ 2,21 say "Gimme an Window color or attribute " GET wattr RANGE 1,255
READ
@ 2,21 say " Gimme a Border color or attribute" GET battr RANGE 1,255
READ
@ 2,21 say " Gimme a Border Character Set (1-5)" GET borcset RANGE 1,5
READ
@ 2,21 say " Gimme a Border Character" GET borchar RANGE 1,255
READ
STORE "S"+chr(trow)+chr(lcol)+chr(btrow)+chr(rcol)+chr(wattr)+;
chr(battr)+chr(borcset)+chr(borchar) TO mstuff
@ 11,22 SAY "Now you See it!(hit a key...)"GET something
READ
CALL DBWNWOAN WITH mstuff
STORE "?" TO something
@ 13,22 SAY "Now you don't!(hit another key...)" GET something
READ
STORE "R" TO mstuff
CALL DBWNWOAN WITH mstuff
STORE "?" TO something
@ 15,20 SAY "Had enough? (Y/N) " GET mquitter
READ
IF .NOT. mquitter $ "Yy"
STORE "?" TO mquitter
CALL DBWNWOAN with mhold
wait to nothing
Call DBWNWOAN with "R"
ENDIF
ENDDO
return
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/