home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
01e
/
miscfunc.zip
/
DB2ATTR.PRG
< prev
next >
Wrap
Text File
|
1988-04-12
|
4KB
|
100 lines
** DB2ATTR.PRG - translates dBase string expressions for color to DOS
** display attribute's numeric expression
PARAMETERS colorvar,decattr
PRIVATE dbbg,dbfg
**
** Copyright Steve Titterud 1988
** 2157 Glenridge Ave.
** St. Paul, MN 55119
** (612)-739-7229
**
** Sister routine is ATTR2DB.PRG. Easily converted to a QS function.
**
** Usage: do db2attr with <color variable>,"<numeric variable name>"
**
** These routines were written to solve a problem I have encountered. I have
** occasion to use add-on assembler routines, either in .bin form for LOAD
** and CALL, or in .obj form for CCALLing. When these routines have a display
** function, they often ask for a display attribute as a decimal number. And
** further, what they are displaying needs be integrated, in terms of color,
** intensity, and so on, with the rest of the display, which is set with dBase
** color commands as strings. The same is true in reverse - dBase color
** commands need to correspond to color commands set by one of these routines
** with a decimal number attribute. Therefore I created routines to both
** find a dBase color expression corresponding to a decimal attribute, and
** to find a decimal attribute corresponding to a dBase color expression.
** This allows these values to be set at run-time based upon the color
** context, as expressed in a different form (number or string).
**
** This ought to be written in assembler or C, but I'm not able at present.
**
** Decattr is the QUOTED NAME of the variable which will hold the
** decimal value of the attribute byte recognized by DOS, corresponding
** to colorvar, a dBase expression for color (includes "/" separator).
** This variable name is then macro-expanded for the assignment.
**
** A valid expression for colorvar is assumed, in form FG/BG.
**
** Initialize &decattr to 0
**
&decattr=0
**
** Parse dBase color expression for FG and BG subexpressions:
**
dbfg = upper(ltrim(rtrim(left(colorvar,at("/",colorvar)-1))))
dbbg = upper(ltrim(rtrim(right(colorvar,len(colorvar)-at("/",colorvar)))))
**
** Add in value of foreground component:
**
do case
case dbfg="W"
&decattr=&decattr+7
case dbfg="GR"
&decattr=&decattr+6
case dbfg="RB"
&decattr=&decattr+5
case dbfg="R"
&decattr=&decattr+4
case dbfg="BG"
&decattr=&decattr+3
case dbfg="G"
&decattr=&decattr+2
case dbfg="B"
&decattr=&decattr+1
case dbfg="N"
&decattr=&decattr+0
endcase
**
** Add in value of background component:
**
do case
case dbbg="W"
&decattr=&decattr+112
case dbbg="GR"
&decattr=&decattr+96
case dbbg="RB"
&decattr=&decattr+80
case dbbg="R"
&decattr=&decattr+64
case dbbg="BG"
&decattr=&decattr+48
case dbbg="G"
&decattr=&decattr+32
case dbbg="B"
&decattr=&decattr+16
case dbbg="N"
&decattr=&decattr+0
endcase
**
** Add in value of intensity component:
**
&decattr=&decattr+iif("+"$dbfg,8,0)
**
** Add in value of blinking component:
**
&decattr=&decattr+iif("*"$dbfg,128,0)
?
? &decattr
?
RETURN