5748145 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n qwin.bas
   1: '--------------------------------------------------------------------------
   2: '                               QBASWIN2.TMP
   3: '
   4: '  This is a "template" upon which to build your QBASIC programs using
   5: '  QBASWIN II.  Copy this file to a .BAS extension and you're ready!
   6: 
   7: '  IMPORTANT:  The window memory buffer is set at maximum, 32766...if you're
   8: '  running out of memory, you may decrease this number, but be careful.
   9: '  If you overfill the buffer, you'll run into a String Space Corrupt for
  10: '  sure!  And that's bad.  If you're using ZoomUp or ZoomDown, leave it
  11: '  it at 32766 if at all possible.  If you're using just PopUp and PopDown,
  12: '  you can calculate the exact amount of memory you'll need to set aside.
  13: '  The memory required to save one window is (r+1)*(c+1)+10, where r and c
  14: '  are the number of rows and columns, respectively.  So, if you know
  15: '  how many windows you'll have up at one time, and their size, you know
  16: '  the minimum memory you'll need to set aside.  Say, for 4 windows,
  17: '  20x20, you'll need a minimum of (21*21+10)*4 = 1764.  Set winmem% to
  18: '  1764.
  19: '
  20: '                        *         *         *
  21: '
  22: '  THIS IS PUBLIC DOMAIN SOFTWARE.  YOU MAY FREELY DISTRIBUTE THIS PROGRAM
  23: '  ONLY IN ITS ORIGINAL FORM.  MODIFIED VERSIONS ARE NOT TO BE DISTRIBUTED.
  24: '
  25: '  For more information on QuickBASIC programming libraries or if you have
  26: '  any questions about QBASWIN II, you may contact the author, John Strong,
  27: '  at Strongsoft, 3155 SW 178th Avenue, Aloha, OR 97006. (203)436-2836
  28: '
  29: '---------------------------------------------------------------------------
  30: 
  31: DECLARE SUB InitWindow (mem%)
  32: DECLARE SUB popup (ulr%, ulc%, lrr%, lrc%, attr%, frame%, shadow%, saveit%)
  33: DECLARE SUB popdown ()
  34: DECLARE SUB ZoomUp (ulr%, ulc%, lrr%, lrc%, attr%, frame%, shadow%, saveit%, snd%, zooms%)
  35: DECLARE SUB ZoomDown (snd%, zooms%)
  36: REDIM SHARED work%(0), winmem%(0)            'InitWindow will redim these
  37: 
  38: winmem% = 32766                              'window memory buffer size
  39: CALL InitWindow(winmem%)                     'this must be done first
  40: 
  41: '---------------------------------------------------------------------------
  42: 
  43: 
  44: 
  45: '         Your code goes here!  If you have any COMMON variables, you'll
  46: '         need to declare them just after the DECLARE statements above.
  47: '         Have fun!
  48: CALL popup(10, 10, 20, 20, 31, 1, 1, 1)
  49: CALL popup(13, 13, 23, 23, 31, 1, 1, 1)
  50: SLEEP 1
  51: CALL popdown
  52: SLEEP 1
  53: CALL popdown
  54: 
  55: '---------------------- Machine language program data -----------------------
  56: prog:
  57: 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
  58: 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
  59: 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
  60: 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
  61: 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
  62: 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
  63: 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
  64: 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
  65: 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
  66: 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
  67: 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
  68: 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
  69: 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
  70: 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
  71: 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
  72: DATA FB,B0,C0,AB,5E,5F,7,59,5B,8B,E5,5D,CA,10,0
  73: 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
  74: 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
  75: 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
  76: 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
  77: 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
  78: DATA 5D,CA,2,0
  79: 
  80: DEFINT A-Z
  81: SUB InitWindow (mem)
  82:      'work() holds the program
  83:      REDIM work(250)
  84:      DEF SEG = VARSEG(work(0))
  85:      RESTORE prog
  86:      FOR i = 1 TO 499
  87:         READ D$
  88:         POKE i - 1, VAL("&H" + D$)
  89:      NEXT
  90:      DEF SEG
  91:      REDIM winmem(mem)
  92: END SUB
  93: 
  94: SUB popdown
  95:      DEF SEG = VARSEG(work(0))
  96:      winseg = VARSEG(winmem(0))
  97:      CALL absolute(winseg, 375)
  98:      DEF SEG
  99: END SUB
 100: 
 101: SUB popup (ulr, ulc, lrr, lrc, attr, frame, shadow, saveit)
 102:      IF ulr < lrr AND ulc < lrc THEN
 103:           DEF SEG = VARSEG(work(0))
 104:           winseg = VARSEG(winmem(0))
 105:           IF saveit THEN newattr = -attr ELSE newattr = attr
 106:           CALL absolute(ulr, ulc, lrr, lrc, newattr, frame, shadow, winseg, 0)
 107:           DEF SEG
 108:      END IF
 109: END SUB
 110: 
 111: SUB ZoomDown (snd, zooms)
 112:     
 113:      FOR i = 49 TO zooms + 1 STEP -1
 114:           IF snd THEN SOUND i * 110 + 440, .05 ELSE SOUND 0, .08
 115:      NEXT
 116:      FOR i = 1 TO zooms
 117:           CALL popdown
 118:           IF snd THEN SOUND (zooms - i) * 110 + 440, .08 ELSE SOUND 0, .08
 119:      NEXT
 120:      zooms = 0
 121: 
 122: END SUB
 123: 
 124: SUB ZoomUp (ulr, ulc, lrr, lrc, attr, frame, shadow, saveit, snd, zooms)
 125:     
 126:      IF ulr < lrr AND ulc < lrc THEN
 127:           DEF SEG = VARSEG(work(0))
 128:           winseg = VARSEG(winmem(0))
 129:          
 130:           crow = (ulr + lrr) / 2
 131:           ccol = (ulc + lrc) / 2
 132:           IF lrr - ulr > lrc - ulc THEN
 133:                dc = 1
 134:                dr = INT((lrr - ulr) / (lrc - ulc))
 135:           ELSE
 136:                dr = 1
 137:                dc = INT((lrc - ulc) / (lrr - ulr))
 138:           END IF
 139: 
 140:           ulr0 = crow - 1
 141:           lrr0 = crow + 1
 142:           ulc0 = ccol - 1
 143:           lrc0 = ccol + 1
 144:           c = 0
 145:           z = 1
 146:          
 147:           IF saveit = 1 THEN newattr = -attr ELSE newattr = attr
 148:           DO
 149:                z = z + 2
 150:                CALL absolute(ulr0, ulc0, lrr0, lrc0, newattr, frame, 0, winseg, 0)
 151:                ulr0 = ulr0 - dr
 152:                ulc0 = ulc0 - dc
 153:                CALL absolute(ulr0, ulc0, lrr0, lrc0, newattr, frame, 0, winseg, 0)
 154:                lrr0 = lrr0 + dr
 155:                lrc0 = lrc0 + dc
 156:                IF snd THEN SOUND z * 110 + 440, .08 ELSE SOUND 0, .08
 157:           LOOP UNTIL lrr0 >= lrr OR lrc0 >= lrc
 158:           z2 = z
 159:           CALL absolute(ulr, ulc, lrr, lrc, newattr, frame, shadow, winseg, 0)
 160:                    
 161:           DO UNTIL z2 > 49
 162:                z2 = z2 + 2
 163:                IF snd THEN SOUND z2 * 110 + 440, .08 ELSE SOUND 0, .08
 164:           LOOP
 165: 
 166:           DEF SEG
 167:      END IF
 168:      zooms = -(saveit = 1) * z
 169: 
 170: END SUB
 171: 
5748146 [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:08:08