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(, , )

This function calculates the present value of x dollars invested one
time at i percent () to be received in one lump sum ()
after n years (). 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(, , )

This function calculates the present value of x dollars invested one
time at i percent () to be received at the end of every year
() for n years (). 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(, , )

This function calculates the future value of x dollars ()
invested one time at i percent () to be received in one lump
sum after n years (). 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(, , )

This function calculates the sum of an annuity of x dollars
() invested every year at i percent () at the beginning
of every year for n years (). 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(, )

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(, )

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(, , , 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(, , , )

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(, , )

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 command to channel screen
output directly into a file. Better suited to our purposes, however,
is the SET PRINTER TO 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 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