home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST54.PRG < prev    next >
Encoding:
Text File  |  1989-09-10  |  2.8 KB  |  77 lines
  1. ********************
  2.  
  3. FUNCTION Shadow
  4.  
  5.    PARAMETERS _shada, _shadb, _shadc, _shadd, _shadde, _shaddf, _shaddg
  6.  
  7.    PRIVATE _shadcolor, _shadx
  8.    
  9.    IF PCOUNT() = 4
  10.       _shadde = CHR(177)
  11.       _shaddf = 1
  12.       _shaddg = IF ( (TYPE("scrmono") = "U"), .F., !scrmono)
  13.    ELSEIF PCOUNT() = 5
  14.       _shaddf = 1
  15.       _shaddg = IF ( (TYPE("scrmono") = "U"), .F., !scrmono)
  16.    ELSEIF PCOUNT() = 6
  17.       _shaddg = IF ( (TYPE("scrmono") = "U"), .F., !scrmono)
  18.    ENDIF
  19.  
  20.    IF TYPE("_shadde") = "N"
  21.       _shaddf = _shadde
  22.       _shadde = CHR(177)
  23.       _shaddg = .T.
  24.    ENDIF
  25.    _shadde = SUBSTR(IF(EMPTY(_shadde), CHR(177), _shadde), 1, 1)
  26.  
  27.    _shadcolor = SETCOLOR()
  28.    SETCOLOR( STRTRAN( _shadcolor, "+", "" ) )
  29.  
  30.    IF !_shaddg
  31.       DO CASE
  32.       CASE _shaddf = 1                        && Right side, underneath
  33.          FOR _shadx = _shada+1 TO _shadc+1
  34.             @ _shadx, _shadd+1 SAY _shadde + _shadde
  35.          NEXT
  36.          @ _shadc+1,_shadb+1 SAY REPLICATE(_shadde, _shadd-_shadb)
  37.  
  38.       CASE _shaddf = 2
  39.          FOR _shadx = _shada+1 TO _shadc+1
  40.             @ _shadx, _shadb-2 SAY _shadde + _shadde
  41.          NEXT
  42.          @ _shadc+1,_shadb SAY REPLICATE(_shadde, _shadd-_shadb)
  43.  
  44.       CASE _shaddf = 3                        && Left side, on bottom
  45.          FOR _shadx = _shada-1 TO _shadc-1
  46.             @ _shadx, _shadb-2 SAY _shadde + _shadde
  47.          NEXT
  48.          @ _shada-1,_shadb-1 SAY REPLICATE(_shadde, _shadd-_shadb)
  49.  
  50.       CASE _shaddf = 4                        && Right side, on top
  51.          FOR _shadx = _shada-1 TO _shadc-1
  52.             @ _shadx, _shadd+1 SAY _shadde + _shadde
  53.          NEXT
  54.          @ _shada-1,_shadb+2 SAY REPLICATE(_shadde, _shadd-_shadb)
  55.       ENDCASE
  56.    ELSE
  57.       DO CASE
  58.       CASE _shaddf = 1
  59.          RESTSCREEN(_shada+1,_shadd+1,_shadc+1,_shadd+2, DULLING(SAVESCREEN(_shada+1,_shadd+1,_shadc+1,_shadd+2)))
  60.          RESTSCREEN(_shadc+1,_shadb+1,_shadc+1,_shadd+2, DULLING(SAVESCREEN(_shadc+1,_shadb+1,_shadc+1,_shadd+2)))
  61.       CASE _shaddf = 2
  62.          RESTSCREEN(_shada-1,_shadd+1,_shadc-1,_shadd+2, DULLING(SAVESCREEN(_shada-1,_shadd+1,_shadc-1,_shadd+2)))
  63.          RESTSCREEN(_shada-1,_shadb+1,_shada-1,_shadd+2, DULLING(SAVESCREEN(_shada-1,_shadb+1,_shada-1,_shadd+2)))
  64.       CASE _shaddf = 3
  65.          RESTSCREEN(_shada+1, _shadb-2, _shadc+1, _shadb-1, DULLING(SAVESCREEN(_shada+1, _shadb-2, _shadc+1, _shadb-1)))
  66.          RESTSCREEN(_shadc+1, _shadb-2, _shadc+1, _shadd-1, DULLING(SAVESCREEN(_shadc+1, _shadb-2, _shadc+1, _shadd-1)))
  67.       CASE _shaddf = 4
  68.          RESTSCREEN(_shada-1, _shadb-2, _shadc-1, _shadb-1, DULLING(SAVESCREEN(_shada-1, _shadb-2, _shadc-1, _shadb-1)))
  69.          RESTSCREEN(_shada-1, _shadb-2, _shada-1, _shadd-1, DULLING(SAVESCREEN(_shada-1, _shadb-2, _shada-1, _shadd-1)))
  70.       ENDCASE
  71.    ENDIF
  72.  
  73.    SETCOLOR( _shadcolor )
  74.    RETURN("")
  75.  
  76. * End of File
  77.