home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-386-Vol-2of3.iso
/
c
/
cliptree.zip
/
MISC.PRG
< prev
next >
Wrap
Text File
|
1993-02-08
|
6KB
|
181 lines
/*┌──────────────────────────────────────────────────────────────────────┐
▌│ │
▌│ Program Name: MISC.PRG Purpose.: Various functions │
▌│ Date Created: 02/06/93 Language: Clipper 5.0 │
▌│ Time Created: 10:56:24 Author: Kevin S Gallagher │
▌│ PickOne() by: Stephen L. Woolstenhulme │
▌│ │
▌│ │
▌└──────────────────────────────────────────────────────────────────────┘
▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ */
#include "include1.h"
function BoxShad( nTR, nTC, nBR, nBC, cClrs,nShad )
local ShadColor := IF( VALTYPE( nShad ) == "N", CHR(nShad), CHR(8) )
EVAL( ;
{ | cDefCol | cDefCol:=SETCOLOR( cClrs ), ;
RESTSCREEN( nTR+1, nTC+2, nBR+1, nBC+2, ;
TRANSFORM( SAVESCREEN( nTR+1, nTC+2, nBR+1, nBC+2 ), ;
REPLICATE( "X"+ShadColor, ( nBR-nTR+1 ) * ( nBC-nTC+1 ) ) ) ), ;
DISPBOX( nTR, nTC, nBR, nBC,"╔═╗║╝═╚║ "), ;
SETCOLOR( cDefCol ) } )
return nil
/*
* Author: Stephen L. Woolstenhulme
*/
function PickOne( cText, aPicks, nRow, nWhich, cColor )
local nOffSet, nArrayLen, nSpace, nLcol, cScrn, nLen, i
local getlist := {}
memvar gcBoxColor
nOffSet := len( cText ) / 2 + 2
nArrayLen:= 0
nRow := IF( nRow == Nil, 21, nRow )
nWhich := IF( nWhich == Nil, 1, nWhich )
if cColor == Nil
if type( 'gcBoxColor' ) == 'C'
cColor := gcBoxColor
else
cColor := 'w+/r, n/w ,,, w+/n'
endif
endif
nRow := IF( nRow > maxcol() - 1, maxcol() - 1, nRow )
nRow := IF( nRow < 2, 2, nRow )
nLen := len( aPicks )
FOR i := 1 TO nLen
nArrayLen += len( aPicks[ i ] )
NEXT
if nArrayLen + len( aPicks ) - 1 >= len( cText )
nSpace := 2
else
nSpace := ( len( cText ) - nArrayLen ) / ( len( aPicks ) + 1 )
endif
nLcol := ( maxcol() / 2 + 1 ) - ;
( max( len( cText ), nArrayLen + nSpace * len( aPicks ) ) / 2 )
cScrn := savescreen( nRow - 3, 0, nRow + 3, maxcol() )
cColor := SetColor( cColor )
/*
* Steve's code had "Shadow" commented out (didn't include it either)
* I used a generic shadow udf (see below) so not to add any lib calls
*/
Shadow( nRow-2, nLcol-2, nRow+1, 81 - nLcol )
@ nRow - 2, nLcol - 2, nRow + 1, 81 - nLcol box "╔═╗║╝═╚║ "
@ nRow - 1, ( maxcol() / 2 ) - ( len( cText ) / 2 ) say cText
nOffSet := ( maxcol() / 2 + 1 ) - ( nArrayLen + ( nSpace * ( len( aPicks ) + 1 ) ) ) / 2
@ nRow, nOffSet say ""
nLen := len( aPicks )
FOR i = 1 TO nLen
@ nRow, COL() + nSpace prompt aPicks[i]
next
menu to nWhich
setcolor( cColor )
restscreen( nRow - 3, 0, nRow + 3, maxcol(), cScrn )
return nWhich
/*
* What it does: places a shadow around boxes
*/
Procedure Shadow( nTr, nTc, nBr, nBc,nColor )
DEFAULT nColor TO 7
MakeShad( nBr+1, nTc+1, nBr+1, nBc+1,nColor )
MakeShad( nTr+1, nBc+1, nBr+1, nBc+1,nColor )
Return
STATIC Procedure MakeShad( nTr, nTc, nBr, nBc,nColor )
local cStrip:= SAVESCREEN( nTr, nTc, nBr, nBc )
local cTemp := REPLICATE( 'x' +chr(nColor), LEN(cStrip) /2 )
cStrip := TRANSFORM( cStrip, cTemp )
RESTSCREEN( nTr, nTc, nBr, nBc, cStrip )
Return
/*
* Author......: Kevin S. Gallagher
* what it does: shows help at the DOS prompt, called from MAIN()
*/
function CMDHELP(Err)
local Drv:=""
if VALTYPE(Err) == "C"
/*
* gotta error from the errorsystem
*/
alert("READ;ERROR.TXT;FOR LIST OF ERRORS",{" QUIT "})
QUIT
endif
setcolor("w/n")
scroll(0,0,14,80,14)
Drv := SUBS(curdrive(),1,2)
@0,0 say PADR("VTREE by Kevin S. Gallagher",80) color "n/bg"
DevPos(1,0);DevOut("VTREE ","GR+");DevOut("[","RB+")
DevOut("drive","W+");DevOut("]","RB+");DevOut(" [","RB+")
DevOut("/R","W+");DevOut("] [","RB+");DevOut("/W","W+");DevOut("]","RB+")
@ 2,0 say "[drive] --> drive to read"
@ 3,0 say "[/R] --> re-read disk file"
@ 4,0 say "[/W] --> write disk file"
@ 5,0 say "[/?] --> this screen"
@ 6,0 say "Example: Read current log drive "+Drv+" w/o written disk file"
@ 7,0 say "VTREE [enter]"
@ 8,0 say "Read drive H: and write disk array"
@ 9,0 say "VTREE H: /W [enter]"
@11,0 say "VTREE's disk file also works with my file finder utility"
@14,0
quit
return nil
/*
* Author......: Kevin S. Gallagher
* What it does: get the current logged drive
*/
function curdrive
local nHandle:=0,cBuf:=space(20),cDrv:=""
run cd >$$$$$$$$.000
if file("$$$$$$$$.000")
nHandle:=fopen("$$$$$$$$.000",0)
if ferror() = 0
fread(nHandle,@cBuf,20)
fclose(nHandle)
ferase("$$$$$$$$.000")
cDrv:=if("\" $ subs(cBuf,3,1),subs(cBuf,1,3),subs(cBuf,1,2)+"\")
/*
* uncomment for full path
* cdrv += curdir()
*/
endif
endif
cdrv:=upper(cdrv)
return cdrv
#ifdef NEEDME
/*
* inkey as a wait state
*/
function WKEY(nDelay)
local nKey, cblock
DO CASE
CASE pcount() == 0
nKey := inkey()
CASE nDelay == NIL .AND. Pcount() == 1
nKey := inkey(0)
OTHERWISE
nKey := inkey(nDelay)
ENDCASE
cblock := setkey(nKey)
IF cblock != NIL
eval(cblock, Procname(1), Procline(1), NIL)
ENDIF
RETURN nKey
#endif
function DrvReady( cDrv )
local nHandle := fopen( cDrv+":\NUL:")
return ( ferror() <> 3 )