home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / WBASIC14 / WBASIC14.ZIP / BB14.ZIP / SAMPLE7.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-09-04  |  5.4 KB  |  296 lines
  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.  
  296.