5748091 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n sample7.bas
   1: 
   2: 
   3: rem
   4: rem This program demonstrates some simple graphics techniques
   5: rem
   6: rem This program runs under DOS or Windows
   7: rem
   8: rem
   9: 
  10: 
  11:   rem
  12:   rem place to store graphics figures with GET statement
  13:   rem
  14: 
  15:   dim figure(100)
  16: 
  17: 
  18:   rem
  19:   rem go into graphics mode
  20:   rem
  21: 
  22:   seterrlevel 5
  23:   err=0
  24:   screen 12
  25:   if err>0 then
  26:     err=0
  27:     screen 9
  28:     if err>0 then
  29:       err=0
  30:       screen 8
  31:       if err>0 then
  32: 	err=0
  33: 	screen 2
  34: 	if err>0 then
  35: 	  print "Graphics mode not available."
  36: 	end if
  37:       end if
  38:     end if
  39:   end if
  40:   seterrlevel 7
  41: 
  42: 
  43:   rem
  44:   rem Set some variables
  45:   rem
  46: 
  47:    firstbit=1
  48:    charxsize=font(7)
  49:    charysize=font(1)
  50: 
  51:    topy=system(2)
  52:    topx=system(1)
  53: 
  54:    topcolor=15
  55: 
  56: 
  57: 
  58:   rem
  59:   rem is there mouse
  60:   rem
  61: 
  62:   mouseflag=mouseon
  63: 
  64: 
  65:   rem
  66:   REM
  67:   REM LAYOUT SCREEN
  68:   REM
  69:   CLS
  70: 
  71:   line (0,0)-(topx-1,charysize*5+2),4,bf
  72: 
  73:   if mouseflag<>0 then
  74: 
  75:     rem
  76:     rem make my push buttons
  77:     rem
  78:     CBUTTON "Exit",1068,0,"Push",0,(1-firstbit)*charxsize,(1-firstbit)*charysize,8*charxsize,5*charysize,7,1
  79:     CBUTTON "CIRCLE",1059,0,"PUSH",0,(11-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,8*CHARXSIZE,3*CHARYSIZE,7,1
  80:     CBUTTON "SQUARE",1060,0,"PUSH",0,(20-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,8*CHARXSIZE,3*CHARYSIZE,7,1
  81:     CBUTTON "PIE",1061,0,"PUSH",0,(29-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,8*CHARXSIZE,3*CHARYSIZE,7,1
  82:     CBUTTON "LINE",1062,0,"PUSH",0,(38-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,8*CHARXSIZE,3*CHARYSIZE,7,1
  83:     CBUTTON "DOTS..",1063,0,"PUSH",0,(47-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,8*CHARXSIZE,3*CHARYSIZE,7,1
  84:     CBUTTON "MOTION",1064,0,"PUSH",0,(56-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,8*CHARXSIZE,3*CHARYSIZE,7,1
  85: 
  86:   else
  87: 
  88:     rem
  89:     rem make my push buttons when no mouse present
  90:     rem
  91:     CBUTTON "F10-Exit",1068,0,"Push",0,(1-firstbit)*charxsize,(1-firstbit)*charysize,10*charxsize,5*charysize,7,1
  92:     CBUTTON "F1-CIR.",1059,0,"PUSH",0,(12-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,9*CHARXSIZE,3*CHARYSIZE,7,1
  93:     CBUTTON "F2-SQR",1060,0,"PUSH",0,(22-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,8*CHARXSIZE,3*CHARYSIZE,7,1
  94:     CBUTTON "F3-PIE",1061,0,"PUSH",0,(31-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,8*CHARXSIZE,3*CHARYSIZE,7,1
  95:     CBUTTON "F4-LINE",1062,0,"PUSH",0,(40-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,10*CHARXSIZE,3*CHARYSIZE,7,1
  96:     CBUTTON "F5-DOTS..",1064,0,"PUSH",0,(51-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,12*CHARXSIZE,3*CHARYSIZE,7,1
  97:     CBUTTON "F6-MOTION",1066,0,"PUSH",0,(64-FIRSTBIT)*CHARXSIZE,(3-FIRSTBIT)*CHARYSIZE,12*CHARXSIZE,3*CHARYSIZE,7,1
  98: 
  99:   end if
 100: 
 101: 
 102: 
 103: 
 104: 
 105: rem
 106: rem get input from keyboard
 107: rem
 108: 
 109: 100
 110: 
 111:   b$ = INKEY$
 112: 
 113: 
 114:   IF b$ <> "" THEN
 115: 
 116:     rem
 117:     rem look for function keys
 118:     rem
 119: 
 120:     if len(b$)>1 then
 121: 
 122:       if asc(right$(b$,1))=68 then
 123: 
 124: 	rem
 125: 	rem F10 exit
 126: 	rem
 127: 	close #1
 128: 	stop
 129: 
 130:       elseif asc(right$(b$,1))=59 then
 131: 
 132: 	rem
 133: 	rem circle demo
 134: 	rem
 135: 
 136: 	gosub cleararea
 137: 	x=topx/2
 138: 	y=(topy+(charysize*6))/2
 139: 	circle (x,y),topx/6,topcolor
 140: 	gosub delay
 141: 	paint (x,y),1,topcolor
 142: 
 143: 
 144: 
 145:       elseif asc(right$(b$,1))=60 then
 146: 
 147: 	rem
 148: 	rem square demo
 149: 	rem
 150: 
 151: 	gosub cleararea
 152: 	for i%=1 to 5
 153: 	   x1=int(200*rnd)
 154: 	   x1=x1+topx/2-100
 155: 	   y1=int(100*rnd)
 156: 	   y1=y1+(topy+(charysize*6))/2-50
 157: 	   x2=int(200*rnd)
 158: 	   x2=x2+topx/2-100
 159: 	   y2=int(100*rnd)
 160: 	   y2=y2+(topy+(charysize*6))/2-50
 161: 	   c=int(15*rnd)
 162: 	   if i%=3 or i%=5 then
 163: 	     line (x1,y1)-(x2,y2),c,BF
 164: 	   else
 165: 	     line (x1,y1)-(x2,y2),c,B
 166: 	   end if
 167: 	next i%
 168: 
 169: 
 170: 
 171: 
 172: 
 173:       elseif asc(right$(b$,1))=61 then
 174: 
 175: 	rem
 176: 	rem pie demo
 177: 	rem It is the CIRCLE command that supports drawing of pie shaped areas
 178: 	rem
 179: 
 180: 	gosub cleararea
 181: 	x=topx/2
 182: 	y=(topy+(charysize*6))/2
 183: 	circle (x,y),topx/6,topcolor,-1,-3
 184: 	gosub delay
 185: 	paint (x-4,y-4),1,topcolor
 186: 	gosub delay
 187: 	circle (x,y),topx/6,topcolor,-3,-5
 188: 	gosub delay
 189: 	paint (x-12,y+2),4,topcolor
 190: 	gosub delay
 191: 	circle (x,y),topx/6,topcolor,-5,-1
 192: 	gosub delay
 193: 	paint (x+12,y+5),2,topcolor
 194: 
 195: 
 196:       elseif asc(right$(b$,1))=62 then
 197: 
 198: 	rem
 199: 	rem line demo
 200: 	rem
 201: 
 202: 	gosub cleararea
 203: 	for i%=1 to 300
 204: 	   x1=int(200*rnd)
 205: 	   x1=x1+topx/2-100
 206: 	   y1=int(100*rnd)
 207: 	   y1=y1+(topy+(charysize*6))/2-50
 208: 	   x2=int(200*rnd)
 209: 	   x2=x2+topx/2-100
 210: 	   y2=int(100*rnd)
 211: 	   y2=y2+(topy+(charysize*6))/2-50
 212: 	   c=int(15*rnd)
 213: 	   line (x1,y1)-(x2,y2),c
 214: 	next i%
 215: 
 216: 
 217: 
 218: 
 219:       elseif asc(right$(b$,1))=63 then
 220: 
 221: 	rem
 222: 	rem dot demo
 223: 	rem
 224: 
 225: 	gosub cleararea
 226: 	for i%=1 to 300
 227: 	   x=int(200*rnd)
 228: 	   x=x+topx/2-100
 229: 	   y=int(100*rnd)
 230: 	   y=y+(topy+(charysize*6))/2-50
 231: 	   c=int(15*rnd)
 232: 	   pset (x,y),c
 233: 	next i%
 234: 
 235: 
 236:       elseif asc(right$(b$,1))=64 then
 237: 	rem
 238: 	rem motion demo
 239: 	rem
 240: 	gosub cleararea
 241: 	x=topx/2
 242: 	y=(topy+(charysize*6))/2
 243: 	circle (x,y),10,topcolor
 244: 	circle (x,y),4,topcolor-1
 245: 	get (x-10,y-10)-(x+10,y+10),figure(0)
 246: 	gosub cleararea
 247: 	for ix=0 to topx step 10
 248: 	  line (ix,charysize*7)-(ix,topy),topcolor
 249: 	next ix
 250: 	oldix=9999
 251: 	for ix=0 to topx-20 step 2
 252: 	  put (ix,y),figure(0),XOR
 253: 	  if oldix<9999 then
 254: 	    put (oldix,y),figure,XOR
 255: 	  end if
 256: 	  oldix=ix
 257: 	  for i=1 to 30:next i
 258: 	next ix
 259: 
 260:       end if
 261:       goto 100
 262: 
 263:     end if
 264: 
 265:   END IF
 266: 
 267:   GOTO 100
 268: 
 269: 
 270: 
 271: 
 272: 
 273: rem
 274: rem delay 1/2 second
 275: rem
 276: 
 277: delay:
 278:      t=timer
 279: delay5:
 280:      if timer-t<.5 then goto delay5
 281:      return
 282: 
 283: 
 284: 
 285: 
 286: rem
 287: rem erase display area
 288: rem
 289: 
 290: cleararea:
 291: 
 292:      by=charysize*6
 293:      line (0,by)-(topx,topy),0,bf
 294:      return
 295: 
5748092 [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:09:04