
This article is reprinted from the February 1991 edition of TechNotes/dBASE
IV.  Due to the limitations of this media, certain graphic elements such as
screen shots, illustrations and some tables have been omitted.  Where
possible, reference to such items has been deleted.  As a result,
continuity may be compromised.  

TechNotes is a monthly publication from the Ashton-Tate Software Support
Center.  For subscription information, call 800-545-9364.

UDF LIBRARY

It's a Setup

Roland Bouchereau and Dan Madoni

 UDFs provide a steady stream of new functionality, enhancing the dBASE
language
and providing an open-end architecture to the software.

Individual Color Attribute Functions
The SET() function received a boost in version 1.1 of dBASE IV.  Objects in
use such as procedure files and format files can now be determined as well
as a few others.  The SET() function now supports the following parameter
values:

ATTRIBUTES
DEFAULT
DIRECTORY
FILTER
PATH
PROCEDURE
VIEW

Using SET("ATTRIBUTES") returns a character string indicating the color
attributes for all the color area groups.  However, all of the colors are
returned in a string together, making it difficult to separate the color
patterns for individual color areas.  The UDFs shown below ("SET UDFs") can
address each individual area.  If you only find yourself dealing with one
or two areas where color change is required, these may come in handy.

Set UDFs
FUNCTION Normal                   && COLOR OF NORMAL
                PRIVATE normal_
                normal_ = SET("ATTRIBUTES")
RETURN LEFT(normal_,AT(",",normal_) - 1)


FUNCTION Highlight                && COLOR OF HIGHLIGHT
                PRIVATE hilite_
                hilite_ = SET("ATTRIBUTES")
                hilite_ = SUBSTR(hilite_,AT(",",hilite_) + 1)
RETURN LEFT(hilite_,AT(",",hilite_) - 1)


FUNCTION Border                   && Border color
                PRIVATE border_
                border_ = SET("ATTRIBUTES")
RETURN SUBSTR(border_,AT(" &",border_) - 3, 1)


FUNCTION Messages                 && COLOR OF MESSAGES
                PRIVATE messages_
                messages_ = SET("ATTRIBUTES")
                messages_ = SUBSTR(messages_,AT("& ",messages_) + 2)
RETURN LEFT(messages_,AT(",",messages_) - 1)


FUNCTION Titles                   && COLOR OF TITLES
                PRIVATE titles_
                titles_ = SET("ATTRIBUTES")
                titles_ = SUBSTR(titles_,AT("& ",titles_))
                titles_ = SUBSTR(titles_,AT(",",titles_) + 1)
RETURN LEFT(titles_,AT(",",titles_) - 1)


FUNCTION Box                      && COLOR OF BOX
                PRIVATE box_, i_
                box_ = SET("ATTRIBUTES")
                i_ = 0
                DO WHILE i_ # 4
                        box_ = SUBSTR(box_,AT(",",box_) + 1)
                        i_ = i_ + 1
                ENDDO
RETURN LEFT(box_,AT(",",box_) - 1)


FUNCTION Info                     && COLOR OF INFORMATION
                PRIVATE info_, i_
                info_ = SET("ATTRIBUTES")
                i_ = 0
                DO WHILE i_ # 5
                        info_ = SUBSTR(info_,AT(",",info_) + 1)
                        i_ = i_ + 1
                ENDDO
RETURN LEFT(info_,AT(",",info_) - 1)


FUNCTION Fields                   && COLOR OF FIELDS
                PRIVATE fields_
                fields_ = RIGHT(SET("ATTRIBUTES"),7)
RETURN RIGHT(fields_,7 - AT(",",fields_))

Any Identifying Marks?

To help compensate further for those settings that the SET() function can
not reveal, namely SET CURRENCY, SET CURRENCY TO, SET POINT TO, SET
SEPARATOR, and SET DATE.  The following four UDFs make use of another
powerful built-in dBASE function.  The TRANSFORM() function allows the
programmer to format any datum using a character string that could specify
a template for a PICTURE clause.  For example:

. ? TRANSFORM(-123.45,"@(") 
(       123.45)"

TRANSFORM() can therefore be used to determine the settings for SET
CURRENCY, SET CURRENCY TO, SET POINT, and SET SEPARATOR.  The UDFs
CurrIs(), CurrPos(), PointIs(), and Separator(), respectively, return these
values . 

Transform UDFs
FUNCTION CurrPos
RETURN IIF(LEN(TRANSFORM(9,"@$")) = 10,"LEFT","RIGHT")


FUNCTION Currency
                PRIVATE pos_,currstr_
                pos_ = LEN(TRANSFORM(9,"@$")) = 10
                SET CURRENCY RIGHT
                currstr_ = SUBSTR(TRANSFORM(9,"@$"),11)
                IF pos_
                        SET CURRENCY LEFT
                ENDIF
RETURN currstr_


FUNCTION PointIs
RETURN LEFT(TRANSFORM(.9,".9"),1


FUNCTION Separator 
RETURN SUBSTR(TRANSFORM(9999,"9,999"),2,1)


The SET DATE setting is another condition that can not be determined
through the use of the SET() function.  This does not make it easy on the
programmer should support for multiple date formats be necessary.  A good
point, though, is that all the styles conform to three basic styles only
differing by the particular separator used.  

Date orders are either year, month and day (YMD), day, month and year (DMY)
or month, day and year (MDY).  With that in mind, you only really need two
functions to determine the proper appearance for dates.  One to determine
the current SET MARK setting, the other to determine the appropriate
order.  MarkIs() and DateForm() perform these respective functions .

Date UDFs
FUNCTION MarkIs
                PRIVATE cent_, its_
                cent_ = SET("CENTURY") = "ON"
                SET CENTURY OFF
                its_ = SUBSTR(DTOC(DATE()),3,1)
                IF cent_
                        SET CENTURY ON
                ENDIF
RETURN its_


FUNCTION DateForm
                PRIVATE today_, temp_, first_
                today_ = DATE()
                IF MONTH(today_) = DAY(today_)  && To make them different
                        today_ = today_ + 1
                ENDIF

                temp_ = SET("CENTURY") = "ON"
                SET CENTURY ON
                first_ = INT(VAL(DTOC(today_)))
                IF .NOT. temp_
                        SET CENTURY OFF
                ENDIF

                DO CASE
                        CASE first_ = YEAR(today_)
                                temp_ = "YMD"
                        CASE first_ = MONTH(today_)
                                temp_ = "MDY"
                        CASE first_ = DAY(today_)
                                temp_ = "DMY"
                ENDCASE
RETURN temp_
 
A File By Any Other Name.

In its wide variety of useful and practical commands, dBASE IV includes the
ability to store an existing filename into a variable using 

DEFINE POPUP <popup name>PROMPT FILES LIKE

The only catch to this is that you are forced to halt execution of your
program and allow the user to select the desired file.

There are a few instances where this will present a problem.  In one of my
applications, the program must check several databases for the presence of
a certain character string knowing only that the databases it must search
have a .DBF extension.

With a file extension as a parameter, this UDF, AFiles() (see "AFiles"),
returns the number of files that exist with the given extension.  In the
process, AFiles() fills an array with the applicable file names.  

Suppose you have a directory containing the following files:

MAIN.PRG                CUSTOMER.DBF    AFILES.LOD
CUST.PRG                TEST.PRG                SAMPLE.DBF              

Given the following command, the variable fnum would equal 3 because there
are three files in the directory with a .PRG extension.  

fnum = AFiles("PRG")

If you did a DISPLAY MEMORY, you would also notice that the following is
present in memory:

AFILES[1,1] = "MAIN.PRG"
AFILES[2,1] = "CUST.PRG"
AFILES[3,1] = "TEST.PRG"

With this information, your program could now perform a loop operation to
do the necessary processing for each file.  

-----------------------------------------------------
AFiles
To use AFiles(), you must first create a database file called AFILES.LOD
and define the following field therein:

Field Name     Field Type     Field Length     Decimal     Index
FILE           Character      50               0           N



FUNCTION AFiles                  
                PARAMETERS afext 
                
                afext = UPPER(afext)             
                IF .NOT. FILE("AFiles.lod")      
                        RETURN 0                      
                ENDIF 
                             
                RUN DIR *.* >AFiles.txt          
                USE AFiles.lod                   
                APPEND FROM AFiles.txt TYPE SDF                           
                IF RECCOUNT() = 0                
                        RETURN 0                      
                ENDIF                             

                SORT ON FILE TO AFTemp.$vd     
                ZAP                              
                APPEND FROM AFTemp.$vd         
                ERASE AFTemp.$vd               
                ERASE Afiles.txt 

                GO TOP                           
                DELETE FOR .NOT. SUBSTR(File,10,3) = afext   
                PACK                                                          
                REPLACE ALL FILE WITH RTRIM(SUBSTR(File,1,8)) + "." +
RTRIM(afext)                               

                ANumFils = RECCOUNT()            
                RELEASE AFiles 
                  
                PUBLIC ARRAY AFiles[ANumFils,1]  
                COPY TO ARRAY AFiles             
                ZAP                              
                USE                                                             
                afclrcntr = 0                    

                DO WHILE afclrcntr < ANumFils    
                        afclrcntr = afclrcntr + 1     
                        afiles[afclrcntr,1] = RTRIM(AFiles[afclrcntr,1])   
                ENDDO                                                            
RETURN ANumFils 
