home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / dbms_mag / 9105 / lief1.may < prev    next >
Text File  |  1991-03-25  |  6KB  |  189 lines
  1.    *   Program: VIRTUAL.PRG
  2.        Date:    February 1991
  3.        Purpose: Demonstrate 5.0 virtual screen trickery with    
  4.                 BEGINPAINT() and ENDPAINT()
  5.        Caveat:  These two functions are undocumented, and are   
  6.                 therefore subject to change at any time without 
  7.                 a moment's notice.
  8.        Compile with: Clipper virtual /n/w*/
  9.    
  10.    #include "box.ch"
  11.    #include "inkey.ch"
  12.    #include "fileio.ch"
  13.    #translate drawbox( <color>, <t>, <l>, <b>, <r>, <fill> ) => ;
  14.      setcolor( <color> ) ; @ <t>,<l>,<b>,<r> box B_SINGLE + <fill> 
  15.   
  16.    #define FLICKER    .F.
  17.    #define NOFLICKER  .T.
  18.    
  19.    function main_stub
  20.    Blinkey()
  21.    Curtains()
  22.    inkey(5)
  23.    Movement(FLICKER)
  24.    Movement(NOFLICKER)
  25.    return nil
  26.    
  27.    /*   Function: BLINKEY()
  28.         Purpose:  Flashing alternate screens 
  29.         to drive you crazy*/
  30.  
  31.    function blinkey
  32.    local x, screens := {}
  33.    beginpaint()
  34.    setcursor(0)
  35.    drawbox('w/b', 0, 0, maxrow(), maxcol(), '1')
  36.    drawbox('w/r', 5, 5, 17, 74, '2')
  37.    aadd(screens, savescreen(0, 0, maxrow(), maxcol()))
  38.    drawbox('w/r', 0, 0, maxrow(), maxcol(), '1')
  39.    drawbox('w/b', 5, 5, 17, 74, '2')
  40.    aadd(screens, savescreen(0, 0, maxrow(), maxcol()))
  41.    endpaint()
  42.    do while inkey(.2) = 0
  43.       x = if(x = 1, 2, 1)
  44.       beginpaint()
  45.       restscreen(0, 0, maxrow(), maxcol(), screens[x])
  46.       endpaint()
  47.    enddo
  48.    return nil
  49.    /*   End Function BLINKEY() */
  50.  
  51.    /*   Function: CURTAINS()
  52.         Purpose:  Demonstrate spreading curtains effect*/
  53.  
  54.    function Curtains
  55.    local x
  56.    beginpaint()
  57.    setcursor(0)
  58.    drawbox('w/b', 0, 0, maxrow(), maxcol(), ' ')
  59.    drawbox('w/r', 5, 5, 19, 74, ' ')
  60.    drawbox('w/rb', 9, 15, 16, 64, ' ')
  61.    drawbox('n/bg', 11, 24, 14, 55, ' ')
  62.    @ 12, 32 say "The Killer App"
  63.    @ 13, 26 say "Copyright (c) 1991 Joe Blow"
  64.    save_drape('title.scr')
  65.    setcolor('w/n')
  66.    cls
  67.    endpaint()
  68.    inkey(0)
  69.    pull_drape('title.scr')
  70.    return nil
  71.    /* End Function CURTAINS() */
  72.    
  73.    /* Function: PULL_DRAPE()
  74.       Purpose:  Draw title screen from specified memory file 
  75.       Excerpted from the Grumpfish Library*/
  76.  
  77.    function Pull_Drape(cfile)
  78.    local nhandle, screen_ := {}, buffer, xx, yy, midpoint, ;
  79.      mwidth, mlength, oldcurs := setcursor(0), ndelay := 10    
  80.      if file(cfile)
  81.        if ( nhandle := fopen(cfile, FO_READ) ) != -1
  82.          mwidth = ( maxrow() + 1 ) * 2
  83.          buffer = space(mwidth)
  84.          for xx = 1 to maxcol() + 1
  85.             fread(nhandle, @buffer, mwidth)
  86.             aadd(screen_, buffer)
  87.          next
  88.          fclose(nhandle)
  89.          midpoint = int((maxcol() + 1) / 2) + 1
  90.          for xx = midpoint to maxcol() + 1
  91.             restscreen(0, xx - 1, maxrow(), xx - 1, screen_[xx])
  92.             restscreen(0, maxcol() + 1 - xx, maxrow(), ;
  93.              maxcol() + 1 - xx, screen_[maxcol() + 2 - xx])
  94.              for yy = 1 to ndelay
  95.              next
  96.          next
  97.        endif
  98.      endif
  99.    setcursor(oldcurs)
  100.    return NIL
  101.    
  102.    /* End Function Pull_Drape()  */
  103.  
  104.    /*   Function: SAVE_DRAPE()
  105.         Purpose:  Save title screen to specified memory file
  106.         Excerpted from the Grumpfish Library*/
  107.  
  108.    function save_drape(cfile)
  109.    local buffer, nhandle := fcreate(cfile), xx, ret_val := .f.   
  110.     if ferror() = 0
  111.       ret_val = .t.
  112.       for xx = 0 to maxcol()
  113.          buffer = savescreen(0, xx, maxrow(), xx)
  114.          if fwrite(nhandle, buffer) != ( maxrow() + 1) * 2
  115.             ret_val = .f.
  116.             exit
  117.          endif
  118.       next
  119.       fclose(nhandle)
  120.    endif
  121.    return ret_val
  122.    /* End Function SAVE_DRAPE() */
  123.  
  124.   /*   Function: MOVEMENT()
  125.       Purpose:  Resize a box with the arrow keys */
  126.  
  127.    function Movement(noflicker)
  128.    local t := 10, l := 10, b := 12, r := 69, x, oldscrn, key := 0
  129.    setcursor(0)
  130.    setcolor('w/b')
  131.    /* draw bogus backdrop to prove the point */
  132.    for x = 0 to maxrow()
  133.       @ x, 0 say replicate(chr(x), maxcol() + 1)
  134.    next
  135.    oldscrn = savescreen(0, 0, maxrow(), maxcol())
  136.    setcolor('n/bg')
  137.    @ t, l, b, r box '─┐│┘─└│ '
  138.    /* first allow anchoring of top left corner */
  139.    do while key != K_ESC .and. key != K_ENTER
  140.       key = inkey(0)
  141.       do case
  142.          case key = K_LEFT .and. l > 0
  143.             l--
  144.          case key = K_RIGHT .and. l < r + 1
  145.             l++
  146.          case key = K_UP .and. t > 0
  147.             t--
  148.          case key = K_DOWN .and. t < b - 1
  149.             t++
  150.       endcase
  151.       if noflicker
  152.          beginpaint()
  153.       endif
  154.       restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  155.       @ t, l, b, r box '─┐│┘─└│ '
  156.       if noflicker
  157.          endpaint()
  158.       endif
  159.    enddo
  160.    key = 0
  161.    @ t, l, b, r box '┌─┐│─└│ '
  162.    /* now allow anchoring of bottom right corner */
  163.    do while key != K_ESC .and. key != K_ENTER
  164.       key = inkey(0)
  165.       do case
  166.          case key = K_LEFT .and. r > l + 1
  167.             r--
  168.          case key = K_RIGHT .and. r < maxcol()
  169.             r++
  170.          case key = K_UP .and. b > t + 1
  171.             b--
  172.          case key = K_DOWN .and. b < maxrow()
  173.             b++
  174.       endcase
  175.       if noflicker
  176.          beginpaint()
  177.       endif
  178.       restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  179.       @ t, l, b, r box '┌─┐│─└│ '
  180.       if noflicker
  181.          endpaint()
  182.       endif
  183.    enddo
  184.    return nil
  185.    
  186.    /* End Function MOVEMENT()
  187.    
  188.    /************** End of Program VIRTUAL.PRG *************/
  189.