This article is reprinted from the July 1990 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.



1  You Need Help? August 1990 dBASE IV

You Need Help?
Dan Madoni

Context sensitive help functionality does much to enhance an
application.  Unfortunately, quite a bit of extra programming time is
necessary to provide a Help facility.  It's time consuming enough just
typing the help text itself.

Hence, the motivating factor for this article, borne out of an idea of
making help text easier to implement.  The concept is built around the
use of a UDF I call GetHelp().

Upon issuing GetHelp() and providing a record number as a parameter
for the location of the help text in a .dbf file, a shadowed box will
drop down and display the help text.  Certain parts of the text can be
highlighted to provide a contrast in appearance and are designated by
delimiters in the help text file.  Special high-order ASCII characters
can also be displayed.  The user can scroll downward through the text
and is instructed by a small down arrow which appears if more text is
present.  The text is displayed until the user presses the Esc key. 
The help box rolls up and disappears from the screen leaving what was
beneath in tact.

GetHelp() requires only one database file with one field as opposed to
other conventional  methods which require a database file with two
fields and an index file for lookup purposes.

How it Works

The sample below shows a listing of records taken from a database file
called Dblog.hlp.  I use this as my help text file with a reference
retrieval application that I wrote in dBASE IV:

Record #     Text

 1           \\\ LOGS on Main Menu    
 2           Use the \Logs\ choice to 
 3           access, view, and update 
 4           LOG files.
 5           \\ 22 
 6           *    
 7           *    
 8           \\\ Cursor Movement to LOGS    
 9           Use \|25|\, \|24|\, \|27|\, and \|26|\ to    
10           position the arrow on a  
11           Log.  Press \Enter\ to   
12           choose Log for operation.
13          
14           To create a new Log,     
15           position the arrow over  
16           a space where there is no
17           Log and press \Enter\.   
18           \\\
19           *
20           * 
21           \\ 4
22           
23           Only those LOG files
24           which are in the 
25           \current sub-directory\
26           will be displayed.
27           \\\

There is a point in my reference retrieval program where a user can
move an arrow around the screen to select an icon.  In addition to the
directional arrow keys and the Esc key, the F1 key is trapped.  It is
here where the code issues the statment: 

?? GetHelp(8, "BG+/G", "W+/G"))

Consider the example that follows:

SELECT 10
USE MyHelp
SELECT 1
USE MyDBF
context = 8
...
waiting = INKEY(0)
DO CASE
        CASE WAITING = 28
                ?? 
                SELECT 10      
                GetHelp(context,"BG+/G","W+/G")
                SELECT 1
        ...
ENDCASE

GetHelp() positions the record pointer at record #8, (as specified by
the variable context).  If record 8 did not begin with a triple
backslash, which is understood by the UDF to be the beginning of a
particular topic of a help sequence, GetHelp() would return
immediately with no action taken.

GetHelp() drops a help box from the upper left of the screen and
begins to display  up to the next 10 records of help text in the color
specified by the second parameter.  The word records should be
synonymous with lines in this case since each line of help text or
instruction represents a record in the help file.   Each line (or
record) of text, however, is translated to look a certain way
depending on how text within that line is delimited.

For example, the backslash that delimits "Enter" on line 17 in the
listing to the left means that the word "Enter" will appear in the
color specified by the third parameter.  The "pipe" character that
delimits the numbers on line 9 instructs the UDF that those numbers
are to be interpreted as ASCII values, and are to appear as their
ASCII character representations.  Note that they are also delimited
with a backslash so that they will also take on the special color
characteristic as specified by the third parameter.

If the help text consists of more than ten lines, a small the down
arrow will appear at the lower right-hand corner of the help box.  The
user can press the down  arrow key to scroll through the help text.

Another feature of GetHelp() is the ability to add text anywhere in
the file.  For example, \\ 22 on line 5 tells GetHelp() that more text
for this help item continues on line 22.  The \\ 4 on line 21 tells
GetHelp() that the previous line of help text for this item can be
found on line 4.  This means that all the information that would be
viewed in a particular help screen need not be sequentially ordered in
the help text file.

This is a different approach to the problem of providing concise and
transportable help information for your end-user applications.  The
code that follows will allow you to implement the concepts.     

FUNCTION gethelp
PARAMETERS help_pos, ghnorm, ghintense
*--- Note that colors are hard coded.  In dBASE IV version 1.1 use SET("ATTRIB") to
*    return the color settings before invoking this routine.
GO help_pos 

IF .not. SUBSTR(TEXT, 1, 3) = "\\\" 
   RETURN("") 
ELSE
   SKIP 1
ENDIF    

SAVE SCREEN TO mastscr  
SAVE SCREEN TO helpscr  

waiting = 1   
DO while waiting < 12   
   waiting = waiting + 1
   
   @ 0,3 FILL TO waiting + 1,35 COLOR w/n   
   
   SET COLOR TO &ghnorm    
   @ 0,2 CLEAR TO waiting,34 
ENDDO    

RESTORE SCREEN FROM helpscr  
SET COLOR TO w/n   
@ 3,4 FILL TO 14,35 COLOR w/n

SET COLOR TO &ghnorm 
@ 2,3 CLEAR TO 13,34    
SAVE SCREEN TO helpscr  

DECLARE bphrase[10]
DECLARE ephrase[10]

skipper = help_pos + 1  

DO while .t.  
   helppgcnt = 0   
   RESTORE SCREEN FROM helpscr    
   GO skipper 
   
   SET COLOR TO gr+/G   
   @ 12,33 SAY " " 
   
   DO while helppgcnt < 10 .and. .not. EOF()
      helppgcnt = helppgcnt + 1   
      
      lit = .f.    
      STORE 0 TO numphrs,waiting,chrspcs    
      DO CASE 
         CASE SUBSTR(TEXT, 1, 3) = "\\\" 
            SKIP -1
            EXIT   
            
         CASE SUBSTR(TEXT, 1, 2) = "\\"  
            GO val(SUBSTR(rtrim(TEXT), 3))
      ENDCASE 
      
      IF helppgcnt = 10 
         @ 12,33 SAY CHR(25) 
      ENDIF   
      
      helpline = ""
      
      DO while waiting < len(rtrim(TEXT))   
         waiting = waiting + 1    
         DO CASE   
            CASE SUBSTR(TEXT, waiting, 1) = "\"
               IF lit   
                  lit = .f.  
                  ephrase[numphrs] = (waiting + 4 - (numphrs * 2) - chrspcs)
               ELSE
                  numphrs = numphrs + 1
                  lit = .t.  
                  bphrase[numphrs] = (waiting + 6 - (numphrs * 2) - chrspcs)
               ENDIF    
               
            CASE SUBSTR(TEXT,waiting,1) = "|"
               chrcode = ""  
               
               DO while .t.  
                  chrspcs = chrspcs + 1
                  
                  waiting = waiting + 1
                  IF SUBSTR(TEXT,waiting,1) = "|"
                     EXIT
                  ELSE  
                     chrcode = chrcode + SUBSTR(TEXT, waiting, 1)
                  ENDIF 
               ENDDO    
               helpline = helpline + CHR(val(chrcode))
               
            OTHERWISE   
               helpline = helpline + SUBSTR(TEXT, waiting, 1)
         ENDCASE   
      ENDDO   
      
      waiting = 0  
      @ (helppgcnt + 2),5 SAY helpline COLOR &ghnorm
      
      DO while waiting < numphrs  
         waiting = waiting + 1    
         @ (helppgcnt + 2),bphrase[waiting] FILL TO (helppgcnt + ;
         2), ephrase[waiting] COLOR &ghintense
      ENDDO   
      
      SKIP 1  
   ENDDO 
   GO skipper 
   
   waiting = inkey(0)   
   
   DO CASE    
      CASE waiting = 5  
         SKIP -1   
         
      CASE waiting = 24 
         SKIP 1    
         
      CASE waiting = 27 
         EXIT 
   ENDCASE    
   
   DO CASE    
      CASE RECNO() = help_pos
         SKIP 1    
         
      CASE SUBSTR(TEXT, 1, 3) = "\\\"    
         SKIP -1   
         
      CASE SUBSTR(TEXT, 1, 2) = "\\"
         GO val(SUBSTR(rtrim(TEXT), 3)) 
   ENDCASE    
   
   skipper = RECNO()    
ENDDO    

waiting = 12  
DO while waiting >= 1   
   RESTORE SCREEN FROM mastscr    
   waiting = waiting - 1
   
   @ 0,3 FILL TO waiting + 1,35 COLOR w/n   
   
   SET COLOR TO &ghnorm    
   @ 0,2 CLEAR TO waiting,34 
ENDDO    

RESTORE SCREEN FROM mastscr

RETURN('')    && End of Function: GetHelp



2  UDF Hors d'oeuvres August 1990 dBASE IV

UDF Hors d'oeuvres
Adam L. Menkes

Well, I'm back for another round.  Last month, I offered Macro Man!
and who knows if you've recovered from that article.  Well, hold your
breath.  This time, I've taken on UDFs with a vengeance.  In this
article, I present some pretty serious financial  functions for all
you money-minded folks.  Call me, let's do lunch!  There are a few
statistical and mathematic functions for the digitally driven.  Then
on the somewhat interesting but, perhaps,  archaic side, temperature
conversion and statistic UDFs for every occasion.  I'll be waiting to
see if I get fan mail from some grateful person who has been waiting
for a Kelvin conversion utility. 

Financial Functions

In this first set of financial functions, all the arguments
incorporated are (naturally) numeric and would be entered accordingly
without quotes.

Present Value in Future

        PVIF(<payment>, <rate>, <periods>) 

This function calculates the present value of x dollars invested one
time at i percent (<rate>) to be received in one lump sum (<payment>)
after n years (<periods>). For example, if you wanted to have one
million dollars ($1,000,000) when you retired in 20 years, and if you
could put your money in a CD earning 8%, you would need
PVIF(1000000,.08,20)that is, you would need to invest 214,548.21 and
not touch it for 20 years.

FUNCTION PVIF
        PARAMETERS mPayment, mRate, mPeriods
        mRate = IIF(mRate > 1.00, mRate / 100, IIF(mRate <= 0, 0, mRate))
        * Checks to see if the rate was entered in whole number, rather
        *  than decimal form (i.e. 12% should be .12), then checks for a
        *  non-negative value.
RETURN (1 / (1 + mRate)^mPeriods) * mPayment

Present Value in Future Annuity

        PVIFA(<payment>, <rate>, <periods>)

This function calculates the present value of x dollars invested one
time at i percent (<rate>) to be received at the end of every year
(<payment>) for n years (<periods>).  For example, if you wanted to
have income of $1,000 per year for 20 years, and if you could put your
money in an annuity earning 8%, you would need PVIFA(1000,.08,20)that
is you would need to purchase an annuity for 9,818.15 to receive this
income.

FUNCTION PVIFA
        PARAMETERS mPayment, mRate, mPeriods
        mrate = IIF(mrate > 1.00, mrate/100, IIF(mrate <= 0,;
         .00000001, mrate))     
        * Checks to see if the rate was entered in whole number, rather
        *  than decimal form (i.e. 12% should be .12), then checks for a
        *  non-negative and non-zero value (to avoid dividing by 0).
        mPeriods = IIF(mPeriods < 1, 1, mPeriods)
        * The term cannot be less than 1 year.
RETURN ((1 - (1 / ((1 + mRate)^mPeriods))) / mRate) * mPayment

Future Value in Future

        FVIF(<payment>, <rate>, <periods>)

This function calculates the future value of x dollars (<payment>)
invested one time at i percent  (<rate>) to be received in one lump
sum after n years (<periods>).  For example, if you invested $10,000
now for 20 years, and if you could put your money in a CD earning 8%,
you would receive FVIF(10000,.08,20)that is, you would receive
$46,609.57 in 20 years.

FUNCTION FVIF
        PARAMETERS mPayment,mRate, mPeriods
        mRate = IIF(mRate >= 1.00, mRate / 100, IIF(mRate <= 0, 0, mRate))
        * Checks to see if the rate was entered in whole number, rather
        *  than decimal form (i.e. 12% should be .12), then checks for a
        *  non-negative value.
RETURN ((1 + mRate)^mPeriods) * mPayment

Future Value In Future Annuity

        FVIFA(<payment>, <rate>, <periods>)

This function calculates the sum of an annuity of x dollars
(<payment>) invested every year at i percent (<rate>) at the beginning
of every year for n years (<periods>).  For example, if you made
regular payments of $1,000 per year to an annuity (life insurance, for
example)  for 20 years, and if you could put your money in an annuity
earning 8%, your annuity will be worth FVIFA(1000,.08,20)that is,
your annuity will have accumulated a total of $45,761.96.

FUNCTION FVIFA
        PARAMETERS mPayment, mRate, mPeriods
        mRate = IIF(mRate > 1.00,mRate / 100, ;
                IIF(mRate <= 0, .00000001, mRate))
        * Checks to see if the rate was entered in whole number, rather
        *  than decimal form (i.e. 12% should be .12), then checks for a
        *  non-negative and non-zero value (to avoid dividing by 0).
        mPeriods = IIF(mPeriods < 1, 1, mPeriods)
        * The term cannot be less than 1 year.
RETURN ((((1 + mRate)^mPeriods) - 1) / mRate) * mPayment

Converting APR to Effective Rate 

        APR2Eff(<Annual Percentage Rate>, <periods>)

These next functions convert interest expressed as an annual
percentage rate (APR) to the effective rate or vice versa. If a money
market account earns 9 3/4% annual interest and interest is compounded
monthly, your effective yield is APR2Eff(9.75,12) or 10.1977%.  If
compounded weekly, the yield is APR2Eff(9.75,52) or 10.23%.

FUNCTION APR2Eff
        PARAMETERS mApr, mPeriods
RETURN (((1 + (mApr / (mPeriods * 100)))^mPeriods) - 1) * 100

Converting Effective Interest Rate to APR

        Eff2APR(<Effective Interest Rate>, <periods>)

Conversely, if a company is running an ad in The Wall Street Journal
showing an investment yielding 14.5%, the actual interest is
Eff2APR(14.5,52) = 13.558 if compounded weekly and Eff2APR(14.5,12) =
13.617 if compounded monthly.  As you can see, the compounding periods
are as important as the rate of interest for maximizing your ROI
(Return On Investment).  

FUNCTION Eff2APR
        PARAMETERS mEff, mPeriods
RETURN ((1 + (mEff / 100))^(1 / mPeriods) - 1) * 100 * mPeriods

Determining the Remaining Balance of a Loan

        Balance(<beginning balance>, <rate>, <periods>, <period to
check>)

Suppose you have been making payments on a $100,000 house for 30 years
(360 payments) at 12% interest (1% per month) with payments of 1028.61
per month (determined by the dBASE IV function PAYMENT(100000, .01,
360)). After 1 year (12 payments), you would like to know your
remaining balance on this loan. Balance(100000, .01, 360, 12) =
$99,637.15 gives you the remaining balance. Your principal reduction
is $100,000 - $99,637.15 = $362.85 (pretty sad, considering you have
paid $1,028.61 * 12 = $12,343.32). 

By trial and error, we can determine that the loan is almost half paid
off in approximately 24 years and 5 months. This trial and error
process could easily be done in a simple DO WHILE loop (.WHILE
Balance(mPayment, mRate, mPeriods, n) >= PV(mPayment, mRate, mPeriods)
/ 2, n = n + 1.).

.? Balance(100000, .01, 360, 293)
50055.35

FUNCTION Balance
        PARAMETERS mPV, mRate, mPeriods, mBalloon
        mPayment=ROUND(PAYMENT(mPV, mRate, mPeriods), 2)
RETURN mPV *((1+mRate) ^mBalloon) ;
        -(mPayment *(((1 +mRate) ^mBalloon) -1) /mRate)

Note that there is no parameter for the payments. This is calculated
by the PAYMENT function which must be ROUNDed to 2 decimal places
since payments are made in dollars and cents.  

Converting an Add-On Interest Rate to an Annual Percentage Rate

        AOAPR(<beginning balance>, <rate>, <periods>, <periods per year>)

What is Add-On interest and how does this differ from simple interest?
Add-On interest simply takes the interest to be paid, adds this to the
principal balance, and divides the total by the number of payments, 
whereas simple interest is based on the balance of the loan after each
period.  

For example, a car dealer just pressured you into buying the
four-wheeled lemon he calls a car, and because of the factory rebate
(that has been added in to the price to give the illusion of a
discount) and the low, low interest rate of 7.9%, you are convinced
that you got a great deal. Ignoring all but the interest rate, you
want to determine the rate you are actually paying on this $15,000
pile of depreciating scrap metal over 5 years. With simple interest at
10%, you can determine that your payments will be PAYMENT(15000,
.10/12, 60) = 318.71 per month. How good a deal are you getting at
7.9%? 

First, take the loan amount ($15,000) and multiply by the add-on
interest (.079) = $1,185 and multiply this by the number of years (5)
to get the total interest to be paid over the life of the loan
($5,925).  Add this to the principal balance to get $20,925 and divide
by the number of payments (60) to get the monthly payment of $348.75.
Why is the monthly payment $30.04 higher even though the rate is
lower? Because add-on interest does not take into account principal
reduction after each payment. Comparing the interest rates, we see
that AOAPR(15000, .079, 60, 12) = .1396 (13.96%), which is higher than
the bank rate of 10%.  

FUNCTION AOAPR
        * Requires the INTEREST Function.
        PARAMETERS mPV, mAORate, mPeriods, mPperYr          
        * Beginning Balance, Add-On Int. Rate, Periods, Periods per Year.
        mAOI = mPV * mAORate * (mPeriods / mPperYr) && 1 yr. interest rate.
        mPmt = (mPV + mAOI) / mPeriods              && Periodic payment.
RETURN Interest(mPV, mPmt, mPeriods) * mPperYr   && APR

Determining the Periodic Interest Rate of a Loan

        Interest(<payment>, <rate>, <periods>)

This function calculates the interest rate of a loan. How this is done
is by checking the present value of the loan (the beginning balance)
against the calculated present value of a loan based on different
interest rates. 

For an alternate method of calculating interest, see Curt Schroeders'
article entitled dBasic Financial Calculator in the January 1990 issue
of TechNotes/dBASE IV.  

This trial and error process was originally conceived in that an
arbitrary starting point, say 50%, was checked, and if the present
value using this rate was too low, subtract 10% (1/10^n when n = 1)
until the value was too high, whereby 10% would be added and 1%
subtracted (+ 1 / 10^n, n = n + 1, - 1 / 10^n) and repeated in a DO
WHILE loop until the PV() of the guessed interest rate either matched
the beginning balance, was within .00...001 decimal places (determined
by user), or where PV(..., interest rate + 1 / 10^n, ...) = PV(...,
interest rate - 1 / 10^n, ...) i.e. where the exact interest rate
could not be determined due to level of PRECISION (can not be set
larger than 18). Although it worked well, it was very slow, as it
would check each value as follows:  

.5, .4, .3, .2, .1, 0, .09, .08, .07, .06, .05, .04, .03, .02, .01, 0,.009, .008 .....

until the value return an approxiamtion of the desired PV(). 

The function below uses a binary search, instead of sequential (as
above) so that it keeps taking the midpoint of two values until the
two values are equal (or nearly equal, depending on how precision is
set). For a further explanation of Binary vs. Sequential and how this
can affect the speed of execution, see "Using a Binary Search to
Compute Cube Roots" by Ralph Davis in the September 1985 TechNotes. 

For example, you are going through the Notice of Defaults filed at the
County Recorder's office to find houses in foreclosure (one of my
favorite passtimes). You find one where the original loan amount is
$100,000 for 30 years with payments of $1028.61 per month but have no
idea as to the interest rate. Interest(100000, 1028.61, 360) = .01 (1%
per month) = 12% annual.

The variables bottom and top  set the initial acceptable interest
range from 0% to 50%. The Top = .50 is an arbitrary maximum interest
per period. 1 (100%) could be used, as well as a number such as .04 as
.04 per month is 48% annual.

FUNCTION interest
PARAMETERS mbegbal, mpayment, mperiods

SET PRECISION TO 18
SET DECIMALS TO 18
BOTTOM = 0
TOP = .5 
guess = (BOTTOM + TOP) / 2    && Mid-point for binary search.

DO while abs(mbegbal - pv(mpayment, guess, mperiods)) >= .00001
   *    Loop until the approximation (Guess) of the interest rate
   *    is accurate to within .00001. This figure is arbitrary and
   *    can be set to suit your needs, as greater accuracy will
   *    decrease speed of recalculation. .01 will execute more
   *    quickly than accuracy to within .0000000001.
   
   IF pv(mpayment, guess, mperiods) < mbegbal
      *     If the calculated Present Value is less than the
      *     actual Present Value (Beg. Balance), reset the range.
      TOP = guess
      guess = (guess + BOTTOM) / 2
   ELSE
      BOTTOM = guess
      guess = (guess + TOP) / 2
   ENDIF
ENDDO
RETURN guess
        
You may want to add the following in your code before getting
INTEREST()

mDeci = SET("DECIMALS")

and afterwards

SET DECIMALS TO mDeci

since this function SETs DECIMALS TO 18.

 Statistical Functions

Calculating the Factorial of a Number

        Fact(n)

This is a simple function to calculate factorials for a number n. 
Factorials are denoted by "!" such that 5! = 1 * 2 * 3 * 4 * 5 =
120.  

FUNCTION fact
PARAMETER mnumber
mloop = mnumber
mfact = mnumber
DO while mloop > 0
   mfact = mfact * mloop
   mloop = mloop - 1
ENDDO
RETURN mfact / mnumber

Calculating the "Quick Sum"

        QSum(expN)

Rather than doing this function in a DO WHILE loop similar to FACT()
where you would add mNumber to itself + 1 (instead of multiplying),
you can see that, for any number n, the sum of the numbers can be
viewed as follows: 

1 + 2 + 3 +.98 + 99 + 100 = (1 + 100) + (2 + 99) + (3 + 98) +.(50 +51).

In other words, for summing the numbers from 1 to 100, you need to
determine how many times to multiply the value 101 (or n + 1).  As
these numbers are being paired, the multiple is n / 2. As any odd
number multiplied by any even number results in an even number, n * (n
+ 1) / 2 will always be a whole number.  The example above:  Qsum(5) =
5 * (5 + 1) / 2 = 5 * 6 / 2 = 30 / 2 = 15.  As you can see,
Qsum(100000000) could take some time in a DO WHILE loop, but is a
simple calculation based on this method. 

FUNCTION Qsum
        PARAMETER mNumber
RETURN mNumber * (mNumber + 1) / 2

For summing a range of numbers, say from 50 to 175, simply use

        ? Qsum(175) - Qsum(50).

Calculating Possible Combinations

        Combo(n, t)

This function calculates the number of possible combinations of n
items taken t at a time.

Okay, lotto fans, this one's for you!  There are 49 (n) numbers from
which you must select 6 (t) numbers. The total possible combinations
of selecting 6 out of 49 numbers is C49,6 (standard notation) or
Combo(49,6) which is 13,983,817 possible combinations. Since the order
that the numbers are selected does not matter (2, 20, 45, 6, 16, and
48 is equivalent to 2, 6, 16, 20, 45, and 48 or any other combination
of these 6 numbers), it is necessary to divide out the number of
choices that would be redundant.

Now that you know how to figure your odds of winning the state lottery
(1 in 13,983,817), you know that whenever the jackpot is over 14
million dollars, you should rush to the local store to fill out and
purchase $14 million worth of tickets and you will be a guaranteed
winner (provided no one else matches the 6 numbers - in which case you
will share the jackpot) and you will be able to afford the
Carpal-Tunnels surgery to correct your writer's cramp from filling out
all these forms. 

FUNCTION Combo
        PARAMETERS mTotChoice, mChoices
RETURN IIF(mTotChoice = mChoices, 1, ;
        Fact(mTotChoice) / (Fact(mChoices) * Fact(mTotChoice - mChoices)))

Note: If n = t, there is only 1 combination possible (all). 
Additionally, Combo(49, 6) is the same as Combo(49,43), or more
generally, Combo(n, t) = Combo(n, n - t). This can be thought of as
one problem phrased two ways: 

For example,  consider the equation

Combo(5,2) = Combo(5,3)

as the number of ways that any 2 items can be selected from 5 or the
number of ways that any 3 items are not selected from 5.

Items ABCDE

        Selected        Un-Selected
        AB AC AD AE     CDE BDE BCE BCD
        BC BD BE        ADE ACE ACD
        CD CE   ABE ABD
        DE      ABC

or conversely

        Selected        Un-Selected
        ABC ABD ABE ACD ACE ADE DE CE CD BE BD BC
        BCD BCE BDE     AE AD AC
        CDE     AB

You can see how you will arrive at the same result regardless of which
value of t you select.

Determining the Number of Combinations

        Permu(n, t)

With this function, you can calculate the number of possible
permutations of n items taken t at a time.

For example, you are going to the track to bet your paycheck on some
horses, instead of the Gamblers Anonymous meeting as you had
originally intended.  You would like to know your odds of betting the
exacta, which is betting on which horse will finish 1st (win), which
one will come in second (place) and which horse finishes 3rd (show).
Assuming 10 horses are running, and each horse is as good as the
others, the probability of horse x winning is 1/10. Let's say you want
horses 2, 4, 7 to win, place, and show. The probability of this exacta
paying off is 1/10 * 1/9 * 1/8 as each success is dependent on the
previous success such that even if horse 4 places and horse 7 shows,
it still requires that horse 2 wins for the payoff. Therefore, if
horse 2 wins (1/10), there are nine horses which could place (1/9) and
if this occurs, there is a 1/8 chance that horse 7 will show. The
order (2, 4, 7) is important, as (2, 7, 4), (4, 2, 7), (4, 7, 2), (7,
2, 4), and (7, 4, 2) will not pay.  Permu(10, 3) tells us that there
is a 1 in 720 chance of winning this exacta (1 / 10 * 9 * 8).  

FUNCTION Permu
        *-- Requires FACT() function.
        PARAMETERS mTotChoice, mChoices
RETURN IIF(mTotChoice = mChoices, Fact(mTotChoice), Fact(Mtotchoice) ;
/ Fact(Mtotchoice - Mchoices))  &&  If N = T, this is the same as N!

Temperature Conversion Functions

This next batch of temperature conversion functions will convert
degrees from any one of the three standard scales to any other of
these scales (Fahrenheit, Celsius, or Kelvin). 0K is absolute zero. 

Fahrenheit to Celsius

        FtoC(expN)

Converts degrees Fahrenheit to degrees Celsius (Centigrade).

FUNCTION FtoC
        PARAMETER Temperature
RETURN ((Temperature+40)*(5/9))-40

Celsius (Centigrade) to degrees Fahrenheit

        CtoF(ExpN)

Converts degrees Celsius (Centigrade) to degrees Fahrenheit

FUNCTION CtoF
        PARAMETER Temperature
RETURN ((Temperature+40)*(9/5))-40

Celsius to Kelvin 

        CtoK(expN)

Converts degrees Celsius to degrees Kelvin .

FUNCTION CtoK
        PARAMETER Temperature
RETURN Temperature + 273

Fahrenheit to Kelvin

        FtoK(expN)

Converts degrees Fahrenheit to degrees Kelvin

FUNCTION FtoK
        PARAMETER Temperature
RETURN FtoC(Temperature)+273    &&Note that this requires FUNCTION
FtoC.

Kelvin to Celsius

        KtoC(expN)

Converts degrees Kelvin to degrees Celsius

FUNCTION KtoC
        PARAMETER Temperature
RETURN Temperature - 273
Kelvin to Fahrenheit

        KtoF(expN)

Converts degrees Kelvin to degrees Fahrenheit

FUNCTION FtoK

        PARAMETER Temperature
RETURN FtoC(Temperature) - 273  && Note that this requires FUNCTION
FtoC

You may notice that the FtoC and CtoF functions did not have the
conversion you may have expected from your school days. You may say,
"Hey, doesn't the formula to convert Celsius to Fahrenheit and vice
versa have something to do with 32"?  Well, the formulas you were
probably thinking about are : 

F = (9/5 * -C) + 32 
C = 5/9 * (F - 32)

Could you ever keep the parentheses straight? Could you ever remember
to add or subtract 32 from the appropriate formula?  Well, even if you
opt not to use the above functions, you can derive a simple shortcut
for calculating Farenheit to Celsius and vice versa.

F = (C + 40) * 9/5 - 40
C = (F + 40) * 5/9 - 40

Math Functions

Right Triangle Function

        RTrgl(ExpN1,ExpN2,ExpN3)

Ever had that secret urge to determine the length of the 3rd side of a
right triangle (you remember, one of the angles  must be 90) given
the length of the other 2 sides.  This is the function that'll help
you indulge in your geometric fantasy!

Here are a few examples.  First, to determine the length of the
hypotenuse (the side opposite the 90 angle), given lengths of side A
and side B as 3 and 4 respectively, hypotenuse = RTrgl(3,4,0) (pass
the parameter 0 for the value you are trying to determine) = 5.    
Example 2 : SideB = RTrgl(5,0,13) = 12.

Do you remember the Pythagorean Theorum?

FUNCTION rtrgl
PARAMETERS adj, opp, hyp
* Adjacent Side, Opposite Side, Hypotenuse
DO CASE
   CASE adj = 0 .and. opp <> 0 .and. hyp <> 0
      side = sqrt((hyp^2) - (opp^2))
   CASE adj <> 0 .and. opp = 0 .and. hyp <> 0
      side = sqrt((hyp^2) - (adj^2))
   CASE adj <> 0 .and. opp <> 0 .and. hyp = 0
      side = sqrt((adj^2) + (opp^2))
   OTHERWISE
      side=0
ENDCASE
RETURN side

Testing for a Prime Number

        Prime(expN)

This function checks to see if it is a prime number.  A prime number
is one that can only be evenly divided by itself and one (1).  If the
value is prime, .T. is returned, else .F. is returned.

FUNCTION prime
PARAMETER pnum
mnum = pnum
IF mnum <= 1 .or. mnum / 2 = int(mnum / 2)
   * Prime numbers must be whole, positive, odd integers.
   RETURN .f.
ENDIF
mnum = 2
DO while mnum <=  pnum - 1
   IF mod(pnum,mnum) = 0
      *IF pNum / mNum = INT(pNum / mNum)  && Alternate syntax
      * If the remainder is 0, (it can be divided), it is not prime.
      RETURN .f.
   ENDIF
   mnum = mnum + 1
ENDDO
RETURN .t.

Determining the Least Common Denominator

        LCD(expN1, expN2)

If there is no common denominator, 1 is returned. Either number may be
the larger of the two.  Consider the following examples:

.? LCD(27, 9)
                3
.? LCD(14, 21)
                7
.? LCD(7, 10)
                1

FUNCTION lcd
PARAMETERS mnum1, mnum2
IF mnum1 = 1 .or. mnum2 = 1
   RETURN 1
ENDIF
IF mnum1 > mnum2
   maxlcd = mnum2
   largenum = mnum1
ELSE
   maxlcd = mnum1
   largenum = mnum2
ENDIF

mval = 2
DO while mval < maxlcd
   IF mod(maxlcd, mval) = 0 .and. mod(largenum, mval) = 0
      RETURN mval
   ENDIF
   mval =  mval + 1
ENDDO
RETURN 1

Determine the Greatest Common Denominator

        GCD(expN1, expN2)

If there is no common denominator, 1 is returned. Either number may be
the larger of the two.  Using the same examples as in the previous
UDF, notice the results:

.? GCD(27, 9)
                9
.? GCD(14, 21)
                7
.? GCD(7, 10)
                1

FUNCTION gcd
PARAMETERS mnum1, mnum2

IF mnum1 = 1 .or. mnum2 = 1
   RETURN 1
ENDIF

IF mnum1 > mnum2
   maxgcd = mnum2
   largenum = mnum1
ELSE
   maxgcd = mnum1
   largenum = mnum2
ENDIF

mval = maxgcd
DO while mval >= 1
   IF mod(largenum, mval) = 0 .and. mod(maxgcd, mval) = 0
      RETURN mval
   ENDIF
   mval = mval - 1
ENDDO
RETURN 1

Well, that should be enough to keep you busy for a while.  As the
spirit moves me, I will undoubtedly return with more little tidbits
that you can use.  'Til then, don't do anything I wouldn't do (like
recursive UDF calling). 



3  How Low Can You Go? August 1990 dBASE IV

How Low Can You Go?
Roland Bouchereau

The dBASE language can't do everything.  But way back when, the
creators of dBASE III had enough insight to allow for a means of
accomplishing many of those tasks that the dBASE language could not do
alone.  Through the use of .bin files, system resources not directly
available to the dBASE engine are now accessible.  
For the unfamiliar, .bin files are usually assembly language programs
written with the express intent of being executed from inside of the
dBASE environment.  With the advent of dBASE III 1.2 (the Developer's
Release), the LOAD and CALL commands made their appearance.  These
commands provided the basis for an access to low level routines
written in assembly language.  The LOAD command loaded a .bin file
into dBASE memory, and the CALL command passed program control to the
memory location where the .bin file was LOADed.  When execution of the
.bin program in memory is done, control is returned (if all went well)
back to dBASE control.  Having this access to low level functions in
the PC can be a mixed blessing, particularly for the novice.  If you
don't know exactly what's going to happen when CALLing a .bin file,
then it's usually wise not to even try running it. 
Changes In .bin Files

Not long after the appearance of dBASE III PLUS came many products
designed to take advantage of the new low level  interface it
incorporated.  Most notably, these were the dBASE Tools for C, the
Programmer's Library and the Graphics Library, the dBASE Tools: the
Pascal Programmers Library, the dBASE Programmer's Utilities and the
dBASE Programmer's Utilities Volume II.  These products provided added
functionality and features such as access to arrays, financial,
statistical, and mathematical functions, graphics capability, some
form of external language support and access to system resources such
as screen,  keyboard, cursor and mouse control.  Having these new
tools to expand the use of the dBASE programming language made the
product an even more powerful tool for applications development. 
dBASE IV was released in the fall of 1988, with bigger, faster
everything and sporting a richer programming language.  This included
the expanded use of low level interface.  The LOAD command remained
unchanged, but the CALL command was now able to accept up to seven
parameters of various types as compared to the one optional parameter
accessible to dBASE III PLUS programmers.  Also, a new CALL() function
was introduced, also allowing up to seven parameters.  The  CALL()
function can be used to return a value, thus providing a means of
creating assembly language User Defined Functions.  This expanded
functionality turned out to be a mixed blessing however.  Changes in
the way the dBASE engine managed parameters and memory variables
rendered many of the low level tools designed for dBASE III PLUS
unusable.  The table shown below details the differences between the
way the two products provide access to .bin routines.

                        dBASE III PLUS                          dBASE IV

Maximum parameters      1                                       7

Parameter addressing    DS:BX points to optional parameter      DS:BX points to first parameter
                                                                ES:DI points to seven pointer block Parameter count

Parameter count         DS:BX are nil if no parameter present   CX contains parameter count

Pointers reference      Parameter points to actual variable     Pointers address copies of variables

Numeric                 IEEE floating point format              Null terminated, STR() representation

Date                    IEEE floating point format              Null terminated, DTOS() representation (YYYYMMDD)

Character string        Null terminated character strings       Null terminated character strings

Logical                 One byte (0 = FALSE, 1 =TRUE)           'F' or 'T' followed by null byte

Access to the parameters in dBASE IV is not only more extensive but
more stable.  If a dBASE III PLUS type .bin required no parameters or,
at most, required one character parameter, then that .bin would likely
work in dBASE IV.  Otherwise, the unpredictable could occur. 
In addition to the differences in parameter passing conventions, dBASE
IV does not manage memory variables in the same manner that dBASE III
PLUS did.  Many dBASE III PLUS-type .bin files expected memory
variables to be located directly after the variable being passed as
the parameter.  However, In dBASE IV, the location of the first
parameter has no bearing on the address of the related variable or
variables.  This difference (besides the severe memory deficit imposed
by dBASE IV 1.0 requirements) is what rendered all of the dBASE Tools 
series unusable.  Nearly all of the .bin files in the dBASE
Programmers Utilites Volume II fail due to this same variable
addressing phenomenon or to the fact that some of those utilities
attempt to allocate memory from within dBASE IV.  This practice was
dubious in dBASE III PLUS and is deadly in dBASE IV.  The following is
a list of those .bin files from the dBASE Programmers Utilites Volume
II that should work with dBASE IV. 

Ffirst.bin
Fnext.bin
Chdir.bin 
Mkdir.bin
Rmdir.bin 
Getkey.bin
Prn2file.bin

With the exception of Addfiles.bin, all the .bin files from the
original dBASE Programmer's Utilities (Volume 1) should work with
dBASE IV. 
So, despite the travails of using dBASE III PLUS .bin files in dBASE
IV, the expanded capability of dBASE IV .bin files can more than make
up for the loss. Well, to be frank, there are a couple of problems
still left to be ironed out with the CALL command and CALL() function
in dBASE IV version 1.0.  Both the CALL command and the CALL()
function improperly process a date type parameter; both will yield
strange results.  The workaround to this, at least for the time being,
is to send the date as a character string in either DTOS() or DTOC()
format.  The only other anomaly known is with the use of seven
parameters in conjunction with the CALL() function.  If all seven
parameters are used, dBASE IV version 1.0 will hang before returning
from the .bin routine. 

To better illustrate the flexibility of a dBASE IV type .bin file,
I've included the source code to a useful .bin and a small library of
UDFs and  procedures to act as a front end for the .bin file.  The
assembler source code used here should be compatible with MASM 4.0 and
above.  The .bin file should be created using the following steps: 

MASM Search;
LINK Search;
EXE2BIN Search

On the following pages you will find a handy utility that I've come up
with which searches for files on disk and can return several  of the
file characteristics such as the date and time stamp and the file
size.   I then incorporate this functionality into a dBASE program
that creates a popup that allows more elaborate filtering of files.  

For example, suppose you wish to show a popup picklist of files that
had date time stamps for a specific month or day.  This is not
something dBASE IV by itself could accomplish.  But by being able to
access the low level interface, the possibilities become
endless.        

For more information about the Microsoft compiler MASM, contact
Microsoft Corporation, 1 Microsoft Way, Redmond, WA  98052-6399 or
phone 206/882-8080
 
; Program:Search.asm  Source for dBASE IV type .bin file that uses DOS'
;                     find first and find next functions for getting info
;                     about files matching a wildcard specification and
;                     possibly an attribute mask.  Can be called with up to
;                     six parameters, or at least two.  The first parameter
;                     is necessary to indicate the search mode; either to
;                     find the first file (indicated by a 1) or to find
;                     subsequent files (indicated by anything other than a 1).
;                     The second parameter is a filename or wild card string.
;
;                     parameter 1: Call type (1 for first call).
;                     parameter 2: Wildcard specification.
;                     parameter 3: Attribute mask.      (Optional)
;                     parameter 4: Receives file date.
;                     parameter 5: Receives file time.
;                     parameter 6: Receives file size.
;
;  Example:     . LOAD Search
;               . ? CALL("Search",1,"*.dbf       ")     && Two parms.
;                        0
;
;               . fspec = "SQLHOME\*.* "
;               . fattr = "D     "              && Include directories!
;               . fdate = "  /  /  "            && Avoid bug.
;               . ftime = "  :  :  "
;               . fsize = 0
;               . CALL Search WITH 1,fspec,fattr,fdate,ftime,fsize
;               . ? fspec,fsize
;               SQLDBASE.STR        194
;
; Possible directory entry attributes.

        RO      =       00000001b
        HID     =       00000010b
        SYS     =       00000100b
        VOL     =       00001000b
        DIR     =       00010000b
        ARCH    =       00100000b

dgroup  group   code

code    segment byte
        assume  cs:code,ds:dgroup
search  proc    far
        mov     ax,cs                                   ; Assert local
data segment.
        mov     ds,ax
        mov     word ptr [argc],cx              ; Save parameter count.
        cmp     cx,2                            ; Were at least two parameters sent?
        jge     enough
        mov     ax,-94                          ; Return "Wrong number of parameters".
        jmp     done
enough:
        call    getdta                          ; Save DTA locally.
        lea     dx,mydta
        mov     ah,1ah                          ; Set local DTA.
        int     21h                             ; Call DOS.
        lds     si,es:[di]                      ; Address first parameter.
        call    atoi
        cmp     ax,1                            ; Call for "find first"?
        mov     ah,4fh                          ; Assume "find next".
        jne     nextfile
        xor     cx,cx
        cmp     word ptr cs:[argc],3            ; Was an attribute mask specified?
        jl      nomask
        lds     si,es:[di + 8]
        call    getmask
nomask:
        lds     dx,es:[di + 4]                  ; Point to wildcard.
        mov     ah,4eh                          ; Finding first.
nextfile:
        int     21h                             ; Make DOS request.
        push    ax                              ; Save return value...
        pushf                                   ; and flags
        mov     ax,cs                           ; Reassert data segment.
        mov     ds,ax
        call    resetDTA                        ; Restore dBASE' orginal DTA.
        popf
        pop     ax
        jc      done                            ; Carry set indicates error.

        cmp     word ptr [argc],2               ; Filename sent, at least?
        jb      result
        push    es
        push    di
        les     di,es:[di + 4]
        lea     si,fname
        call    strcpy                          ; Return file found to dBASE.
        pop     di
        pop     es

        cmp     word ptr [argc],3               ; Attribute string sent?
        jb      result
        push    es
        push    di
        les     di,es:[di + 8]
        call    maskcpy                         ; Attributes to dBASE.
        pop     di
        pop     es

        cmp     word ptr [argc],4               ; Date parameter sent?
        jb      result
        push    es
        push    di
        les     di,es:[di + 12]
        call    datecpy                         ; Return file date to dBASE.
        pop     di
        pop     es

        cmp     word ptr [argc],5               ; Time parameter sent?
        jb      result
        push    es
        push    di
        les     di,es:[di + 16]
        call    timecpy                         ; Return file time.
        pop     di
        pop     es

        cmp     word ptr [argc],6               ; Parameter for file size?
        jb      result
        mov     ax,[fsize]
        mov     dx,[fsize + 2]
        push    es
        push    di
        les     di,es:[di + 20]
        call    ltoa                            ; Return it.
        pop     di
        pop     es
result:
        xor     ax,ax                           ; A - O.K. Return "no error".
done:
        cmp     word ptr [argc],1               ; Call type specified?
        jb      exit
        les     di,es:[di]
        cwd
        call    ltoa                            ; CALL() return value.
exit:
        ret                                     ; Back to dBASE we go!
search  endp

getdta  proc    near
        push    es
        mov     ah,2fh                          ; Get address of current DTA.
        int     21h                             ; Call DOS.
        mov     word ptr [olddta],bx
        mov     word ptr [olddta + 2],es
        pop     es
        ret
getdta  endp

resetDTA proc   near
        push    ds
        mov     dx,word ptr [olddta]            ; Reset original DTA.
        mov     ds,word ptr [olddta + 2]
        mov     ah,1ah
        int     21h                     ; Call DOS.
        pop     ds
        ret
resetDTA endp

;
;       Atoi: Converts a dBASE parameter to a signed integer (16-bit) 
;                value with the result left in the AX register. Conversion of
;                the dBASE parameter continues until the first non-numeric
;                character is found.
;
;       Expects: DS:SI -> dBASE parameter string.
;
atoi    proc    near
        push    di                                              ; Save parameter address offset.
        xor     ax,ax                                   ; AX and BX are working accumulators.
        mov     bx,ax
        mov     cx,10                                   ; The divisor, ten.
        mov     di,ax                                   ; Sign flag, assume positive.
        cld                                                     ; Move forward.
skipwhite:
        lodsb
        cmp     al,' '                          ; Skip leading spaces.
        je      skipwhite
skipzero:
        cmp     al,'0'                          ; Skip leading zeros.
        jne     chksign
        lodsb
        jmp     skipzero
chksign:
        cmp     al,'+'                          ; Positive? (Not a likely character.)
        je      next
        cmp     al,'-'                          ; Negative?
        jne     digits
        inc     di                                      ; Flag it.
next:
        lodsb
digits:
        cmp     al,'0'                          ; Check for valid digits.
        jb      atoidone                                ; Leave if nonnumeric.
        cmp     al,'9'
        ja      atoidone                                ; Ditto.
        sub     al,'0'
        cbw                                             ; Zero out high byte.
        xchg    ax,bx
        imul    cx                                      ; Multiply by ten to shift place value.
        add     bx,ax
        lodsb
        jmp     digits
atoidone:
        mov     ax,bx
        or      di,di                           ; DI holds sign flag.
        jz      atoiexit
        neg     ax                                      ; Change sign.
atoiexit:
        pop     di                                      ; Restore this.
        ret
atoi    endp

;
;       Getmask: Convert character string representing desired search 
;                attribute to true numeric value.  Result is left in AX.
;
;       Expects: DS:SI -> Attribute string.
;
getmask proc    near
        xor     cx,cx
        cld
        jmp     getchar
chkchar:
        and     al,11011111b                    ; Capitalize.
        cmp     al,'R'                          ; Check for read only.
        jne     hidden
        or      cx,RO
        jmp     getchar
hidden: 
        cmp     al,'H'                          ; Hidden?
        jne     system
        or      cx,HID
        jmp     getchar
system:
        cmp     al,'S'                          ; System?
        jne     volume
        or      cx,SYS
        jmp     getchar
volume:
        cmp     al,'V'                          ; Volume label?
        jne     directory
        or      cx,VOL
        jmp     getchar
directory:
        cmp     al,'D'                          ; Directory?
        jne     archive
        or      cx,DIR
        jmp     getchar
archive:
        cmp     al,'A'                          ; Archive?
        jne     getchar
        or      cx,ARCH
getchar:
        lodsb
        or      al,al
        jnz     chkchar
        ret
getmask endp

;
;       Maskcpy: Convert file attribute to null terminated character string.
;
;       Expects: ES:DI -> dBASE parameter string.
;
maskcpy proc    near
        cmp     byte ptr es:[di],0              ; At end of string?
        je      mcexit
        mov     ah,byte ptr [attr]

        test    ah,RO                                   ; Read only?
        jz      chkHID
        mov     byte ptr es:[di],'R'
        inc     di
        cmp     byte ptr es:[di],0
        je      mcexit
chkHID:
        test    ah,HID                                  ; Hidden?
        jz      chkSYS
        mov     byte ptr es:[di],'H'
        inc     di
        cmp     byte ptr es:[di],0
        je      mcexit
chkSYS:
        test    ah,SYS                                  ; System?
        jz      chkVOL
        mov     byte ptr es:[di],'S'
        inc     di
        cmp     byte ptr es:[di],0
        je      mcexit
chkVOL:
        test    ah,VOL                                  ; Volume label?
        jz      chkDIR
        mov     byte ptr es:[di],'V'
        inc     di
        cmp     byte ptr es:[di],0
        je      mcexit
chkDIR:
        test    ah,DIR                                  ; Directory?
        jz      chkARCH
        mov     byte ptr es:[di],'D'
        inc     di
        cmp     byte ptr es:[di],0
        je      mcexit
chkARCH:
        test    ah,ARCH                                 ; Archive?
        jz      fill
        mov     byte ptr es:[di],'A'
        inc     di
        cmp     byte ptr es:[di],0
        je      mcexit
fill:
        mov     al,' '                                  ; Empty rest of string.
        call    strset
mcexit:
        ret
maskcpy endp

;
;       Datecpy: Translates and copies a DOS format date word to a dBASE
;                type time string.
;
;       Expects: ES:DI -> dBASE parameter string.
;
datecpy proc    near
        mov     ax,[date]
        mov     cl,5
        and     ax,1e0h                                 ; Mask off day and year.
        shr     ax,cl                                   ; Normalize.
        aam
        xchg    ah,al
        add     ax,3030h
        stosw
        mov     byte ptr es:[di],'/'            ; Copy date separator.
        inc     di
        mov     ax,[date]
        and     ax,1fh                                  ; Mask off month and year.
        aam
        xchg    ah,al
        add     ax,3030h
        stosw
        mov     byte ptr es:[di],'/'            ; Once again.
        inc     di
        mov     ax,[date]
        and     ax,0fe00h                               ; Mask off month and day.
        mov     cl,9
        shr     ax,cl
        add     ax,80
        cmp     ax,100                                  ; Using only two digit year.
        jl      century
        sub     ax,100
century:
        aam
        xchg    ah,al
        add     ax,3030h
        stosw
        ret
datecpy endp

;
;       Timecpy: Translates and copies a DOS format time word to a dBASE
;                type time string.
;
;       Expects: ES:DI -> dBASE parameter string.
;
timecpy proc    near
        mov     ax,[time]
        mov     cl,11
        and     ax,0f800h                                       ; Mask off minutes and seconds.
        shr     ax,cl
        aam
        xchg    ah,al
        add     ax,3030h
        stosw
        mov     byte ptr es:[di],':'                    ; Time separator.
        inc     di
        mov     ax,[time]
        mov     cl,5
        and     ax,07e0h                                ; Mask off hours and seconds.
        shr     ax,cl
        aam
        xchg    ah,al
        add     ax,3030h
        stosw
        mov     byte ptr es:[di],':'                    ; Copy second separator.
        inc     di
        mov     ax,[time]
        and     ax,1fh                                          ; Mask off hours and minutes.
        shl     ax,1
        aam
        xchg    ah,al
        add     ax,3030h
        stosw
        ret
timecpy endp

;
;       Ltoa: Converts a signed long integer (32-bit) value to a null
;                terminated string (dBASE parameter), padding unused characters
;                with spaces.  If the dBASE parameter is not large enough to
;                represent the value, the parameter is filled with asterisks
;                ('*') to represent overflow.
;
;       Calls:   Strset
;
;       Expects: ES:DI -> dBASE parameter string.
;
ltoa    proc    near
        cmp     byte ptr es:[di],0              ; At end of dBASE parameter?
        je      ltoaexit
        mov     bp,di                                   ; Save the parameter offset.
        xor     si,si                                   ; Assume non-negative or ".F."
        push    ax                                              ; Save the low word.
        mov     al,' '                                  ; Fill with spaces and move past end.
        call    strset
        pop     ax                                              ; Restore our low word.
        mov     cx,10                                   ; The divisor.
        or      dx,dx                                   ; Negative number?
        jge     positive
        inc     si                                              ; SI now holds ".T."
        not     dx                                              ; Make positive.
        neg     ax
        sbb     dx,-1
positive:
        dec     di                                              ; Move to previous char.
        mov     bx,ax
        mov     ax,dx
        xor     dx,dx
        div     cx
        xchg    bx,ax
        div     cx
        xchg    dx,bx   
        add     bl,'0'                                  ; Make character.
        mov     byte ptr es:[di],bl             ; Store the digit.
        cmp     di,bp                                   ; Are we at the front of the parameter?
        je      atfront
        or      ax,ax                                   ; Anything left to work with?
        jnz     positive
        or      si,si                                   ; Was the number negative?
        jz      ltoaexit
        dec     di                                              ; Step back once again.
        mov     byte ptr es:[di],'-'            ; Put in our minus sign.
        jmp     ltoaexit
atfront:
        or      dx,dx                                   ; Still have stuff to write?
        jnz     oflow
        or      ax,ax
        jnz     oflow
        or      si,si                                   ; Do we need to write a negative sign?
        jnz     oflow
        jmp     ltoaexit
oflow:
        mov     di,bp                                   ; Start back at the beginning.
        mov     al,'*'                                  ; Fill with overflow character.
        call    strset
ltoaexit:
        ret
ltoa    endp

;
;       Strcpy:  Copies a null terminated string to a dBASE parameter,

;                                padding unused characters with spaces.
;
;       Calls:   Strset
;
;       Expects: ES:DI -> dBASE parameter string.
;
strcpy  proc    near
        cld                                                     ; Move forward, just in case.
getch:
        lodsb                                           ; Get next character.
        or      al,al                                   ; End of source string?
        jz      sourceend
        cmp     byte ptr es:[di],0              ; End of dBASE parameter?
        je      scexit
        stosb                                           ; Copy the character.
        jmp     getch
sourceend:
        mov     al,' '                                  ; Fill with spaces.
        call    strset
scexit:
        ret
strcpy  endp

;
;       Strset:  Fills a null terminated string with  specified character.
;
;       Expects: ES:DI > String to be filled.
;                AL        Contains character to fill.
;
strset  proc    near
        cld
        jmp     chknull                                 ; Let's check for a null first.
putch:
        stosb                                           ; Put it where it belongs.
chknull:
        cmp     byte ptr es:[di],0              ; Have we reached the end?
        jne     putch
        ret
strset  endp

argc    dw      0
olddta  dw      0,0

mydta   db      21 dup (0)
attr    db      0
time    dw      0
date    dw      0
fsize   dw      0,0
fname   db      13 dup (0)

code    ends
        end     search



PROCEDURE picklist
*
* This procedure provides a way to create popups that contain the names
* of all available .DBFs and .QBE files for user selection, thus
* circumventing the limitation imposed by the PROMPT FILES LIKE clause
* on a DEFINE POPUP command which only allows one file skeleton to be
* used for the purposes of name filtering.  Files.DBF is expected to
* have the following structure.
*
* Field   Field Name     Type             Width Dec
*   1     NAME           Character        12
*   2     ATTRIBUTES     Character         6
*   3     DATE           Date              8
*   4     TIME           Character         8
*   5     SIZE           Numeric          10
*
use FILES
zap
fname = "*.*          "
attr  = "D     "
fdate = dtoc({})                && Work-around bug.
ftime = "        "
fsize = 0
result = CALL("Search",1,fname,attr,fdate,ftime,fsize)
DO while result = 0
   IF LIKE("*.DBF",fname) .or. LIKE("*.QBE",fname)
      APPEND BLANK
      REPLACE name with fname,;
      attributes with attr,;
      DATE       with CTOD(fdate),;
      time       with ftime,;
      size       with fsize
   ENDIF
   result = CALL("Search",2,fname,attr,fdate,ftime,fsize)
ENDDO
DEFINE POPUP picklist FROM 10,10 TO 21,23 PROMPT FIELD name
RETURN

FUNCTION fileattr
PARAMETER fname_
IF TYPE("fname_") = "C"
   IF .not. ("*" $ fname_) .and. .not. ("?" $ fname_)
      fattr_ = "HSD     "
      IF CALL("Search",1,(fname_),fattr_) = 0
         RETURN TRIM(fattr_)
      ENDIF
   ENDIF
ENDIF
RETURN ""

FUNCTION filedate
PARAMETER fname_
IF TYPE("fname_") = "C"
   IF .not. ("*" $ fname_) .and. .not. ("?" $ fname_)                                          fdate_ = "  /  /  "
      IF CALL("Search",1,(fname_),"",fdate_) = 0
         RETURN CTOD(fdate_)
      ENDIF
   ENDIF
ENDIF
RETURN {}

FUNCTION filetime
PARAMETER fname_
PRIVATE ftime_
IF TYPE("fname_") = "C"
   IF .not. ("*" $ fname_) .and. .not. ("?" $ fname_)
      ftime_ = "  :  :  "
      CALL search with 1,(fname_),"","",ftime_
      RETURN ftime_
   ENDIF
ENDIF
RETURN "00:00:00"

FUNCTION filesize
PARAMETER fname_
PRIVATE fsize_
IF TYPE("fname_") = "C"
   IF .not. ("*" $ fname_) .and. .not. ("?" $ fname_)
      fsize_ = 0
      IF CALL("Search",1,(fname_),"","","",fsize_) = 0
         RETURN fsize_
      ENDIF
   ENDIF
ENDIF
RETURN 0

FUNCTION older
* Use this UDF to determine if a program needs to be recompiled.
* Example:
*
*       IF Older("Myprog.DBO","Myprog.PRG")
*               ? "Please wait while MyProg re-compiles...."
*               COMPILE Myprog
*       ENDIF
*
PARAMETERS file1_,file2_
RETURN dtos(filedate(file1_)) + filetime(file1_) < ;
dtos(filedate(file2_)) + filetime(file2_)




4  Dialogue August 1990 dBASE IV

Dialogue
Questions and Answers

Read-Only is a No-Show

Q:      Is there any way to have a read-only field visible in the
BROWSE table and still have access to my screen form when I press F2?
I have used BROWSE FORMAT to accomplish this but fields that I have
protected by setting Edit options: Editing Allowed to NO do not show
up when I switch to BROWSE.

A:      The BROWSE FORMAT will omit a read-only field since fields
designated as read-only in the screen design are written in the .fmt
file as @...SAY commands which BROWSE FORMAT ignores.  If you need to
have read-only fields visible in this mode, leave the Editing Allowed
option set to YES but type .F. into the Permit Edit if option.  This
will make the cursor skip this field in both formats.  There is one
catch however: fields set in this way can neither be the first nor
last field in the list.

A Worthy Quotation

Q:      I'm attempting to use the TYPE() function to obtain
information on a variable but I always get U (or undefined) even if I
use the command on a field in an open database.  What's missing?

A:      Remember that variable or field names must be enclosed in
quotation marks, for example, TYPE("firstname") will return C if the
variable is character, while TYPE(firstname) will return U for
undefined or unknown.

Amber Waves are Grainy

Q:      How can I make dBASE IV look better on a composite monitor?
The monitor is CGA compatible, but displays only in shades of amber. I
have tried both color and mono options when installing, but many
display areas are too grainy  and are difficult to read.  I did not
have this problem with dBASE III PLUS.  Please make any suggestions
you can.

A:      Remove the color statements from your Config.db file or SET
COLOR to OFF in the Tools: Settings menu or at the dot prompt.

Reporting Without a Break

Q:      I would like to use REPORT FORM.TO FILE but I wish to not have
any page breaks in the output file.  My attempts always end up with
dBASE IV inserting a page break!

A:      Follow the steps listed below:

1.      Remove the page header band from the report, putting the
column headers in the title band.

2.      Set the title band so that it prints only at the beginning of
the report.

3.      Set the page length of the report to 66, with no top or bottom
margins.

4.      Set _peject to "NONE".

5.      Set _padvance to "LINEFEEDS"

POPUP() Expects Uppercase 

Q:      I'm using the POPUP() function in a program and it does not
seem to work.  The problem line is

        IF POPUP() = "Notice"

Well, it doesn't notice anything!  Is this a problem with the software
or with me?

A:      The string you are comparing must be in uppercase.  

"ZSPOOL, 'eh she don'a work"

Q:      dBASE IV conflicts with the Zenith memory resident print
spooler ZSPOOL.  When I try to run dBASE IV with ZSPOOL active, I get
the message: Overlay loader can't find file DBASE2.OVL.  Insert System
disk 2 and press ENTER, or press Ctrl-C to abort.

The file DBASE2.OVL does exist in the DBASE directory, even though the
loader can't find it.  The only solution I have found is to remove or
disable ZSPOOL.  dBASE III PLUS doesn't seem to have this problem   Do
other spoolers or memory resident programs have this problem?

A:      The problem is with ZSPOOL. We understand there is a patch for
ZSPOOL that allows the spooler to be active along side dBASE IV.  We
have also been told that there is a new version of ZSPOOL available in
the ZENITH FORUM on COMPUSERVE.  The new version fixed some other
problem with the spooler.  This information should be verified through
Zenith or local  Zenith group.

Popups and Matrices

Q:      Is there a way to get the DEFINE POPUP.FIELD command to allow
more than one field?  What I really need is to show a popup that
contains both my COMPANY and INVOICE_NO fields?

A:      If the COMPANY and INVOICE_NO are always grouped together and
do not need to be selected separately, you could create a calculated
field in a query or a SET FIELDS TO expression that could then be used
in the popup.

However, the problem gets a little dicey when you want to freely move
back and forth between two or more independent pick lists. 
Maneuvering in a "matrix" warrants some programming.  It can be done,
although there are a few limitations you would have to live with.  So
you don't re-invent the wheel, try looking at the article entitled
"Two-Dimensional Menus" in the April 1989 edition of TechNotes /dBASE
IV.

Text Editors, Yes, Word Processors, Maybe

Q:      Can a word processor be used to edit data in a memo field?

A:      The answer is a qualified "Yes".  You would need to set the
"WP" parameter in your Config.db file to specify the command to invoke
the word processor or text editor you wish to use.  Chapter 6  of the
dBASE IV Language Reference Manual explains all about modifications to
the Config.db file. However, you'll want to make sure that the word
processor saves its files in ASCII text mode, rather than the
proprietary formats that most word processors seem to favor. 
Otherwise, you might not be able to view the file at all except
through that same word processor.

        Incidentally, QEDIT, a shareware text editor made by SemWare
of Marietta, Georgia is available on the BBS for those who wish to
download it.  It receives high marks from our technicians for ease of
use and compatibility with dBASE IV.


5  Made to Order August 1990 dBASE IV

Made to Order
Roland Bouchereau

Every once in a while, when writing dBASE programs, circumstances
require that you create a new .dbf file.  Using the COPY STRUCTURE
EXTENDED and CREATE FROM commands, we can build a structure for a new
file with relative ease.  This is all well  and good, unless you don't
happen to have a .dbf file around to use as a building block.  Sadly,
there is no built-in dBASE mechanism for creating a structure extended
file without a "seedling" file  present.  Fortunately, that's what
this little treatise is all  about.  

What first comes to mind is the question of how to create and write
binary data to a file.  Creating a file is not  difficult.  dBASE IV
allows the familiar SET ALTERNATE TO  <file> command to channel screen
output directly into a file.  Better suited to our purposes, however,
is the SET PRINTER TO FILE <file> command.  Redirecting the print
device in this way simplifies output to the file.  

How the file is initialized

Having created the file, we tackle writing the appropriate values to
the file.  Veteran dBASE programmers are well familiar with the
inability to print nulls (ASCII 0's) or send them to a file through a
typical dBASE procedure.  Writing nulls would be necessary for
creating the header of a .dbf file.  We'll discuss headers more in a
moment.  dBASE IV does have the ability to print any ASCII value
through the use of the new ??? command.  This command allows data to
be written directly to the current print device, bypassing any 
interpretation from the dBASE print engine.  To express a  particular
ASCII value in an output string, enclose the number that represents
the character in curly braces.  For instance,  

??? "{27}{0}" 

would send an escape character directly to the printer, followed by a
null.  It is important to note that the curly brace notation only
works in conjunction with the ???  command, and must be enclosed
within the character string.  So,  the how of creating a dBASE file
has been established, all  that's left is the what.  What to write,
that is.

What Must Be Written

Every dBASE data file begins with what we call a header.  Details  on
a .dbf header can be found in the appendix of the dBASE IV Language
Reference.  As the documentation shows, the  header contains various
information, most notably it's record structure.  The header is
logically separated into sections of 32 byte blocks.  The first block
(sometimes called the header preamble or prologue) contains
information regarding the .dbf in  general: the version type (dBASE
III or IV), whether there exists an  associated memo file (.dbt), the
last date of update, and number of records.  Each of the following
blocks describes each field in the file.

So now we know how to create a .dbf file.  The following procedure
illustrates how to make a structure extended file from.nothing!  Run
the program as follows: 

DO MakeExte  WITH "Strucfil"

Once you have the elements of the most basic .dbf file structure, the
CREATE FROM <file> command will let you make .dbf files to your 
heart's content!        

PROCEDURE makeexte
PARAMETER newdbf
IF TYPE("newdbf") # "C"         && Don't send me numbers, just characters
   RETURN
ENDIF
PRIVATE dbf_name_, pdriveris, pformis
dbf_name_ = LTRIM(rtrim(newbf))

*Let's make sure we've got something.
IF "" = dbf_name_
   RETURN
ENDIF

*Force an extension, if we don't have one.
IF "." $ dbf_name_                     
   dbf_name_ = dbf_name_
ELSE
   dbf_name_ = LEFT(dbf_name_, 8) + ".DBF"
ENDIF
pdriveris = _pdriver
pformis   = _pform

* Use the ASCII print driver so we avoid
* any printer initialization code.
_pdriver  = "ASCII.PR2"
_pform    = ""
SET PRINTER TO                    && Close any open print file
SET PRINTER TO FILE (dbf_name_)   && Create and open our file

*First byte indicates standard .dbf without memos.
??? "{3}"

*Date of last update.
??? CHR(year(DATE()) - 1900) + CHR(month(DATE())) +;
CHR(day(DATE()))

*No records, yet.
??? "{0}{0}{0}{0}"

*Numbers of bytes in header.
??? "{193}{0}"

*Number of bytes in each record.
??? "{19}{0}"

*We gotta have something here to fill out the preamble.
??? replicate("{0}", 20)

*Now write out our structure extended fields.
??? "FIELD_NAME{0}C{0}{0}{0}{0}{10}" + replicate("{0}", 15)
??? "FIELD_TYPE{0}C{0}{0}{0}{0}{1}" + replicate("{0}", 15)
??? "FIELD_LEN{0}{0}N{0}{0}{0}{0}{3}" + replicate("{0}", 15)
??? "FIELD_DEC{0}{0}N{0}{0}{0}{0}{3}" + replicate("{0}", 15)
??? "FIELD_IDX{0}{0}C{0}{0}{0}{0}{1}" + replicate("{0}", 15)

*Write the field (header) terminator.
??? "{13}"
SET PRINTER TO                    && Write ^Z and close file.

*Restore these to make everybody happy.
_pform = pformis
_pdriver = pdriveris

RETURN

