5748231 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n qbaswin2.bas
   1: '---------------------------------------------------------------------------
   2: '
   3: '                     QBASWIN II DEMONSTRATION PROGRAM
   4: '                         written by John Strong
   5: '                              July 1992
   6: '
   7: '  THIS IS PUBLIC DOMAIN SOFTWARE.  YOU MAY FREELY DISTRIBUTE THIS PROGRAM
   8: '  ONLY IN ITS ORIGINAL FORM.  MODIFIED VERSIONS ARE NOT TO BE DISTRIBUTED.
   9: '
  10: '  For more information on QuickBASIC programming libraries or if you have
  11: '  any questions about QBASWIN II, you may contact the author, John Strong,
  12: '  at Strongsoft, 3155 SW 178th Avenue, Aloha, OR 97006. (203)436-2836
  13: '
  14: '  To create your own program using QBASWIN II, refer to file QBASWIN2.TMP
  15: '---------------------------------------------------------------------------
  16: 
  17: DECLARE SUB Background ()
  18: DECLARE SUB BlatantAd ()
  19: DECLARE SUB Delay (n%)
  20: DECLARE SUB GoodBye ()
  21: DECLARE SUB HowToUse ()
  22: DECLARE SUB InitWindow (mem%)
  23: DECLARE SUB Intro ()
  24: DECLARE SUB PopDown ()
  25: DECLARE SUB PopUp (ulr%, ulc%, lrr%, lrc%, attr%, frame%, shadow%, saveit%)
  26: DECLARE SUB Stacker ()
  27: DECLARE SUB WhatsNew ()
  28: DECLARE SUB ZoomDown (snd%, zooms%)
  29: DECLARE SUB ZoomUp (ulr%, ulc%, lrr%, lrc%, attr%, frame%, shadow%, saveit%, snd%, zooms%)
  30: REDIM SHARED work%(0), winmem%(0)  'InitWindow will redim these
  31: 
  32: winmem% = 32766                    'window memory buffer size at maximum
  33: InitWindow winmem%                 'this must be done first!
  34: 
  35: '--------------------------------------------------------------------------
  36: 
  37: Background                         'create background pattern
  38: Intro                              'do snazzy intro           
  39: WhatsNew                           'text on the new features of QBASWIN II
  40: Stacker                            'demo on stacking windows
  41: HowToUse                           'tutorial on using QBASWIN II
  42: BlatantAd                          'I gotta plug my own software!
  43: GoodBye                            'I'm outta here
  44: 
  45: END
  46: 
  47: whatsnewtext:
  48: DATA "QBASWIN II is the latest incarnation of a windowing utility I wrote a little"
  49: DATA "over a year ago called QBASWIN.BAS.  QBASWIN proved to be a very popular"
  50: DATA "little program that gave Microsoft QBASIC, a non-compiling version of"
  51: DATA "QuickBASIC, pop-up window capability.  QBASWIN.BAS contained a small"
  52: DATA "machine-language program that allowed even the novice QBASIC programmer to"
  53: DATA "supercharge the ho-hum menus typical of non-compiled BASIC."
  54: DATA ""
  55: DATA "So what's different with QBASWIN II?  Glad you asked!  The ability to create"
  56: DATA "create super-fast pop-up windows is surely a great addition to QBASIC, but"
  57: DATA "what about when you want to erase a window?  Users wanted to pop up a window"
  58: DATA "and then pop it down again without disturbing the screen underneath, which"
  59: DATA "QBASWIN couldn't do.  But QBASWIN II does!"
  60: DATA ""
  61: DATA "In fact, QBASWIN II will allow you to pop and unpop windows, stack and"
  62: DATA "unstack windows, even create zooming windows!  As with the previous version,"
  63: DATA "QBASWIN II features transparent shadowing and frame."
  64: DATA " "
  65: DATA "I hereby put QBASWIN II in the public domain -- it can be freely distributed"
  66: DATA "as long as it remains in its original form and is not modified in any way."
  67: DATA " "
  68: DATA "                Hit any key to see the window stacking demo!"
  69:                        
  70: UsingText:
  71: DATA "Using QBASWIN II is even easier than using QBASWIN I!
  72: DATA " "
  73: DATA "Accompanying this demo program is a file called QBASWIN2.TMP, which is a"
  74: DATA "template on which to build your QBASIC programs using QBASWIN II.  Merely"
  75: DATA "copy the template file to a .BAS file, i.e., COPY QBASWIN2.TMP MYPROG.BAS,"
  76: DATA "load up the newly created .BAS file into QBASIC and start programming!"
  77: DATA "The window routines are already set up and are ready to go."
  78: DATA ""
  79: DATA "There are four window routines that you can use - PopUp, PopDown, ZoomUp,"
  80: DATA "and ZoomDown.  PopUp will create a window and optionally preserve the"
  81: DATA "underlying screen, and PopDown will restore the most recently saved window."
  82: DATA "Similarly, ZoomUp will create an exploding window effect, and ZoomDown will"
  83: DATA "restore the most recently saved zoomed windows."
  84: DATA ""
  85: DATA "The syntax for PopUp is:"
  86: DATA "         CALL PopUp(ulr%,ulc%,lrr%,lrc%,attr%,frame%,shadow%,saveit%)"
  87: DATA "where:"
  88: DATA "        ulr% - upper left row         attr%   - color scheme"
  89: DATA "        ulc% - upper left column      frame%  - frame switch, 1 or 0"
  90: DATA "        lrr% - lower right row        shadow% - shadow switch, 1 or 0"
  91: DATA "        lrc% - lower right column     saveit% - window save switch, 1 or 0"
  92: DATA "                             (Hit any key)"
  93: 
  94: DATA "The arguments ulr%, ulc%, lrr%, and lrc% are fairly self-explanatory."
  95: DATA "However, the next four might need a little clarification."
  96: DATA " "
  97: DATA "attr%:   This is a color attribute, a number than contains both foreground"
  98: DATA "         and background color information.  The attribute is the background"
  99: DATA "         color times 16 plus the foreground color.  So, for white (7) on"
 100: DATA "         blue (1), the attribute would be (1 * 16) + 7 = 23."
 101: DATA ""
 102: DATA "frame%:  Setting this to 1 will result in a frame around the window, while"
 103: DATA "         setting it to 0 will prevent a frame from being displayed."
 104: DATA " "
 105: DATA "shadow%: Setting this to 1 will result in a transparent shadow underneath"
 106: DATA "         the window, while setting it to 0 will result in no shadow."
 107: DATA " "
 108: DATA "saveit%: The underlying screen will be saved if this is set to 1, allowing"
 109: DATA "         it to be restored later.  No screen save will occur if this is"
 110: DATA "         set to 0."
 111: DATA ""
 112: DATA "The syntax for PopDown is:"
 113: DATA "                             CALL PopDown
 114: DATA "(pretty simple, huh?)"
 115: DATA "                             (Hit any key)"
 116: 
 117: DATA "Using ZoomUp and ZoomDown is much the same, except that there are two"
 118: DATA "extra arguments in ZoomUp and two arguments in ZoomDown."
 119: DATA " "
 120: DATA "The syntax for ZoomUp is:"
 121: DATA "  CALL ZoomUp(ulr%,ulc%,lrr%,lrc%,attr%,frame%,shadow%,saveit%,snd%,zooms%)"
 122: DATA "where:"
 123: DATA "         snd% - sound switch           zooms% - number of saves"
 124: DATA " "
 125: DATA "snd%:    Setting this to 1 will enable sound effects."
 126: DATA " "
 127: DATA "zooms%:  This argument is used between the ZoomUp and ZoomDown routines"
 128: DATA "         and is not an input; it just needs to be in the argument list."
 129: DATA "         It tells the ZoomDown routine how many screen restores need to be"
 130: DATA "         done to zoom down a zoomed window.
 131: DATA ""
 132: DATA "The syntax for ZoomDown is:"
 133: DATA "                      CALL ZoomDown(snd%,zooms%)
 134: DATA "where snd% is used as in ZoomUp and zooms% is as described above.  Once"
 135: DATA "again, zooms% is not an input, it just needs to be there.  Trust me!"
 136: DATA " "
 137: DATA "                             (Hit any key)"
 138: DATA " "
 139: 
 140: BlatantText:
 141: DATA "OK, here's the part where I get to plug my shareware library!  If you've"
 142: DATA "liked how QBASWIN II can supercharge a user interface in QBASIC, then you"
 143: DATA "ought to take a look at
 144: DATA " "
 145: DATA "       *******    EZ-Windows Volume I,  from Strongsoft  *******
 146: DATA " "
 147: DATA "a user interface toolkit for QuickBASIC 4.5 and PDS 7.x.  This library "
 148: DATA "allows the QB programmer to create slick front ends to their programs and"
 149: DATA "forever do away with those choose-by-number menus.  Pulldown menus, pop-up"
 150: DATA "windows with *many* frame and shadow options, scrolling and tagging menus,"
 151: DATA "input routines, dialogue boxes, and much more are included.  And all"
 152: DATA "routines support a mouse!"
 153: DATA " "
 154: DATA "Look for the file EZW1V30A.ZIP on your local BBS, or contact the author"
 155: DATA "(John Strong) to receive the shareware library.  I can be reached at:
 156: DATA " "
 157: DATA "                        Strongsoft"
 158: DATA "                        3155 SW 178th Avenue"
 159: DATA "                        Aloha, OR 97006"
 160: DATA "                        (203) 436-2836 (current number)
 161: DATA " "
 162: DATA "                        (Hit any key to end demo)"
 163: 
 164: 
 165: '-------------------- Machine Language Program Data ------------------------
 166: prog:
 167: DATA 55,8B,EC,83,EC,10,53,51,6,57,56,B9,8,0,BF,0,0,8B,5B,6,8B,7,48,89
 168: DATA 43,F0,47,47,E2,F3,FF,46,F6,FF,46,F4,FF,46,F2,FF,46,F0,BB,0,B0,A1,10,0
 169: DATA 25,30,0,3D,30,0,74,3,BB,0,B8,8E,C3,8B,5E,FE,B8,A0,0,F7,E3,8B,5E,FC
 170: DATA D1,E3,3,C3,8B,F8,57,8B,46,F8,8B,5E,FC,2B,C3,40,8B,D8,53,8B,46,FA,8B,56
 171: DATA FE,2B,C2,40,8B,C8,51,8B,46,F6,3D,0,0,7F,5B,F7,D0,40,89,46,F6,1E,6,57
 172: DATA 51,53,8B,F7,6,8B,46,F0,8E,C0,1F,26,8B,3E,0,0,83,C7,A,57,41,43,51,51
 173: DATA 8B,CB,F3,A5,59,2B,F3,2B,F3,81,C6,A0,0,E2,F0,59,26,89,3E,0,0,8B,46,FE
 174: DATA 26,89,5,8B,46,FC,26,89,45,2,8B,46,FA,26,89,45,4,8B,46,F8,26,89,45,6
 175: DATA 58,26,89,45,8,5B,59,5F,7,1F,BA,0,0,8A,66,F6,B0,20,83,7E,F4,0,74,5
 176: DATA B0,C4,BA,1,0,51,8B,CB,83,7E,F4,0,74,8,50,B0,B3,AB,83,E9,1,58,F3,AB
 177: DATA 83,7E,F4,0,74,8,50,83,EF,2,B0,B3,AB,58,83,FA,0,75,E,83,7E,F2,0,74
 178: DATA 8,50,B0,8,47,AA,4F,4F,58,2B,FB,2B,FB,81,C7,A0,0,59,B0,20,83,7E,F4,0
 179: DATA 74,7,83,F9,2,75,2,B0,C4,BA,0,0,E2,AF,83,7E,F2,0,74,B,8B,CB,B0,8
 180: DATA 83,C7,2,47,AA,E2,FC,83,7E,F4,0,74,27,59,5B,5F,B0,DA,AB,3,FB,3,FB,83
 181: DATA EF,4,B0,BF,AB,50,B8,A0,0,49,F7,E1,3,F8,58,83,EF,2,B0,D9,AB,2B,FB,2B
 182: DATA FB,B0,C0,AB,5E,5F,7,59,5B,8B,E5,5D,CA,10,0
 183: DATA 55,8B,EC,53,51,52,6,57,56,1E,BB,0,B0,A1,10,0,25,30,0,3D,30,0,74,5
 184: DATA BB,0,B8,8E,C3,8B,76,6,8E,1C,8B,36,0,0,83,FE,0,74,44,8B,1C,B8,A0,0
 185: DATA F7,E3,8B,5C,2,D1,E3,3,C3,8B,F8,8B,44,6,8B,5C,2,2B,C3,40,8B,D8,8B,44
 186: DATA 4,8B,14,2B,C2,40,8B,C8,8B,74,8,83,EE,A,89,36,0,0,83,C6,A,41,43,51
 187: DATA 8B,CB,F3,A5,59,2B,FB,2B,FB,81,C7,A0,0,E2,F0,1F,5E,5F,7,5A,59,5B,8B,E5
 188: DATA 5D,CA,2,0
 189: 
 190: DEFINT A-Z
 191: SUB Background
 192:     
 193:      COLOR 3, 1                              'cyan on blue
 194:      CLS
 195:      LOCATE 2, 1
 196:      fill$ = "     ** Strongsoft **     "
 197:      FOR j = 1 TO 11
 198:           FOR k = 1 TO 3
 199:                PRINT fill$;
 200:           NEXT
 201:           PRINT "             ";
 202:           FOR k = 1 TO 2
 203:                PRINT fill$;
 204:           NEXT
 205:      NEXT
 206:      Delay 100
 207: END SUB
 208: 
 209: SUB BlatantAd
 210:     
 211:      attr = 6 * 16 + 14
 212:      ZoomUp 1, 1, 25, 80, attr, 1, 0, 1, 1, zooms1
 213:      COLOR 14, 6
 214:      LOCATE 1, 28
 215:      PRINT "[ Blatant Advertisement ]"
 216:     
 217:      RESTORE BlatantText
 218:      FOR i = 1 TO 22
 219:           READ a$
 220:           IF a$ = "" THEN Delay 1000
 221:           LOCATE i + 2, 3: PRINT a$;
 222:      NEXT
 223:     
 224:      Delay 10000
 225:      ZoomDown 1, zooms1
 226: 
 227: 
 228: END SUB
 229: 
 230: SUB Delay (n)
 231:      n! = n / 100
 232:      IF n! < 0 THEN n! = -n!
 233:      x! = TIMER
 234:      WHILE TIMER < x! + n!
 235:           IF n > 0 THEN
 236:                IF INKEY$ <> "" THEN EXIT SUB
 237:           END IF
 238:      WEND
 239: END SUB
 240: 
 241: SUB GoodBye
 242: 
 243:      Delay 100
 244:      attr = 1 * 16 + 7
 245:      ZoomUp 2, 2, 24, 79, attr, 0, 0, 0, 0, zooms0
 246:      COLOR 7, 0
 247:      Delay 100
 248:      CLS
 249: 
 250: END SUB
 251: 
 252: SUB HowToUse
 253:     
 254:      attr = 5 * 16 + 14
 255:      ZoomUp 1, 1, 25, 80, attr, 1, 0, 1, 1, zooms1
 256:      COLOR 14, 5
 257:      LOCATE 1, 31
 258:      PRINT "[ Using QBASWIN II ]"
 259:     
 260:      RESTORE UsingText
 261:      FOR j = 1 TO 3
 262:           GOSUB clearscreen
 263:           FOR i = 1 TO 22
 264:                READ a$
 265:                IF a$ = "" THEN Delay 1000
 266:                LOCATE i + 2, 3: PRINT a$;
 267:           NEXT
 268:           Delay 10000
 269:      NEXT
 270:     
 271:      ZoomDown 1, zooms1
 272:      EXIT SUB
 273: 
 274: clearscreen:
 275:      attr = 5 * 16 + 14
 276:      ZoomUp 2, 2, 24, 79, attr, 0, 0, 0, 0, zooms0
 277:      RETURN
 278: 
 279: END SUB
 280: 
 281: SUB InitWindow (mem)
 282:      'work() holds the program
 283:      REDIM work(250)
 284:      DEF SEG = VARSEG(work(0))
 285:      RESTORE prog
 286:      FOR i = 1 TO 499
 287:         READ D$
 288:         POKE i - 1, VAL("&H" + D$)
 289:      NEXT
 290:      DEF SEG
 291:      REDIM winmem(mem)
 292: END SUB
 293: 
 294: SUB Intro
 295: 
 296:      attr = 2 * 16 + 14
 297:      ZoomUp 2, 2, 24, 79, attr, 1, 0, 1, 1, zooms1
 298:     
 299:      Delay 25
 300:      attr = 1 * 16 + 15
 301:      ZoomUp 5, 5, 15, 40, attr, 1, 1, 1, 1, zooms2
 302:      COLOR 15, 1
 303:      LOCATE 7, 12: PRINT "Strongsoft Presents..."
 304:      LOCATE 10, 15: PRINT "QBASWIN II !!!"
 305:      LOCATE 12, 17: PRINT "July, 1992"
 306:     
 307:      Delay 200
 308:      attr = 4 * 16 + 14
 309:      PopUp 11, 30, 17, 55, attr, 1, 1, 1
 310:      COLOR 14, 4
 311:      LOCATE 13, 36: PRINT "For DOS 5.0's"
 312:      LOCATE 15, 37: PRINT "QBASIC 1.0"
 313:     
 314:      Delay 200
 315:      attr = 6 * 16
 316:      PopUp 16, 45, 20, 75, attr, 1, 1, 1
 317:      COLOR 0, 6
 318:      LOCATE 18, 47: PRINT "Works with QuickBASIC, too!"
 319:      LOCATE 23, 14
 320:      COLOR 14, 2
 321:      PRINT "(Hit a key at any time to accelerate through the demo)"
 322: 
 323:      Delay 350
 324:     
 325:      FOR i = 1 TO 2
 326:           PopDown
 327:           Delay 50
 328:      NEXT
 329:      ZoomDown 1, zooms2
 330:      Delay 50
 331:      ZoomDown 1, zooms1
 332: 
 333: END SUB
 334: 
 335: SUB PopDown
 336:      DEF SEG = VARSEG(work(0))
 337:      winseg = VARSEG(winmem(0))
 338:      CALL absolute(winseg, 375)
 339:      DEF SEG
 340: END SUB
 341: 
 342: SUB PopUp (ulr, ulc, lrr, lrc, attr, frame, shadow, saveit)
 343:      IF ulr < lrr AND ulc < lrc THEN
 344:           DEF SEG = VARSEG(work(0))
 345:           winseg = VARSEG(winmem(0))
 346:           IF saveit THEN newattr = -attr ELSE newattr = attr
 347:           CALL absolute(ulr, ulc, lrr, lrc, newattr, frame, shadow, winseg, 0)
 348:           DEF SEG
 349:      END IF
 350: END SUB
 351: 
 352: SUB Stacker
 353: 
 354:      frame = 1
 355:      shadow = 1
 356:      saveit = 1
 357:      DEF SEG = 0
 358:      POKE 1050, PEEK(1052)
 359:      DEF SEG
 360:      DO
 361:           FOR i = 1 TO 50
 362:                DEF SEG = 0
 363:                IF PEEK(1050) <> PEEK(1052) THEN ecode = 1: EXIT DO
 364:                DEF SEG
 365:                bg = RND * 7
 366:                fg = RND * 16
 367:                attr = bg * 16 + fg
 368:                ulr = 15 * RND + 1
 369:                lrr = ulr + 8
 370:                ulc = 45 * RND + 1
 371:                lrc = ulc + 33
 372:                PopUp ulr, ulc, lrr, lrc, attr, frame, shadow, saveit
 373:                Delay -1
 374:           NEXT
 375:           COLOR fg, bg
 376:           LOCATE ulr + 4, ulc + 5
 377:           PRINT "Hit any key to continue"
 378:           Delay 100
 379:           FOR i = 1 TO 50
 380:                DEF SEG = 0
 381:                IF PEEK(1050) <> PEEK(1052) THEN ecode = 2
 382:                DEF SEG
 383:                PopDown
 384:                Delay -1
 385:           NEXT
 386:           IF ecode THEN EXIT DO
 387:      LOOP
 388:      IF ecode = 1 THEN
 389:           FOR j = 1 TO i
 390:                PopDown
 391:                Delay -1
 392:           NEXT
 393:      END IF
 394:      DEF SEG = 0
 395:      POKE 1050, PEEK(1052)
 396:      DEF SEG
 397: 
 398: 
 399: 
 400: 
 401: END SUB
 402: 
 403: SUB WhatsNew
 404:     
 405:      attr = 3 * 16 + 1
 406:      ZoomUp 1, 1, 25, 80, attr, 1, 0, 1, 1, zooms
 407:      COLOR 3, 1
 408:      LOCATE 1, 35: PRINT " What's New "
 409:      COLOR 1, 3
 410: 
 411:      RESTORE whatsnewtext
 412:      FOR i = 1 TO 21
 413:           READ a$
 414:           IF a$ = "" THEN Delay 1000
 415:           LOCATE i + 2, 3: PRINT a$
 416:      NEXT
 417: 
 418:      Delay 10000
 419:      ZoomDown 1, zooms
 420: 
 421: END SUB
 422: 
 423: SUB ZoomDown (snd, zooms)
 424:     
 425:      FOR i = 49 TO zooms + 1 STEP -1
 426:           IF snd THEN SOUND i * 110 + 440, .05 ELSE SOUND 0, .08
 427:      NEXT
 428:      FOR i = 1 TO zooms
 429:           PopDown
 430:           IF snd THEN SOUND (zooms - i) * 110 + 440, .08 ELSE SOUND 0, .08
 431:      NEXT
 432:      zooms = 0
 433: 
 434: END SUB
 435: 
 436: SUB ZoomUp (ulr, ulc, lrr, lrc, attr, frame, shadow, saveit, snd, zooms)
 437:     
 438:      IF ulr < lrr AND ulc < lrc THEN
 439:           DEF SEG = VARSEG(work(0))
 440:           winseg = VARSEG(winmem(0))
 441:          
 442:           crow = (ulr + lrr) / 2
 443:           ccol = (ulc + lrc) / 2
 444:           IF lrr - ulr > lrc - ulc THEN
 445:                dc = 1
 446:                dr = INT((lrr - ulr) / (lrc - ulc))
 447:           ELSE
 448:                dr = 1
 449:                dc = INT((lrc - ulc) / (lrr - ulr))
 450:           END IF
 451: 
 452:           ulr0 = crow - 1
 453:           lrr0 = crow + 1
 454:           ulc0 = ccol - 1
 455:           lrc0 = ccol + 1
 456:           c = 0
 457:           z = 1
 458:          
 459:           IF saveit = 1 THEN newattr = -attr ELSE newattr = attr
 460:           DO
 461:                z = z + 2
 462:                CALL absolute(ulr0, ulc0, lrr0, lrc0, newattr, frame, 0, winseg, 0)
 463:                ulr0 = ulr0 - dr
 464:                ulc0 = ulc0 - dc
 465:                CALL absolute(ulr0, ulc0, lrr0, lrc0, newattr, frame, 0, winseg, 0)
 466:                lrr0 = lrr0 + dr
 467:                lrc0 = lrc0 + dc
 468:                IF snd THEN SOUND z * 110 + 440, .08 ELSE SOUND 0, .08
 469:           LOOP UNTIL lrr0 >= lrr OR lrc0 >= lrc
 470:           z2 = z
 471:           CALL absolute(ulr, ulc, lrr, lrc, newattr, frame, shadow, winseg, 0)
 472:                    
 473:           DO UNTIL z2 > 49
 474:                z2 = z2 + 2
 475:                IF snd THEN SOUND z2 * 110 + 440, .08 ELSE SOUND 0, .08
 476:           LOOP
 477: 
 478:           DEF SEG
 479:      END IF
 480:      zooms = -(saveit = 1) * z
 481: 
 482: END SUB
 483: 
5748232 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:07:37