** FNC.PRG by Rob Arnold 11/14/88


** Function choose:
**
**   Syntax:
**     CHOOSE(<ExpC1> [,<ExprC2>[,<ExprC3>]])
**   Purpose:
**     This function allows the user to select a record in a file just by giving 
**     it the name of a field.  It takes care of saving the screen, drawing a 
**     box and calling ACHOICE() to let the user select the record.
**
**     Note that since ACHOICE() is used the database file is limited to 4,096 
**     records (but then, anyone who writes a program that makes a user select a 
**     single record from 4,095 others with a scrolling window should be hung, 
**     shot, and then made to watch 4,096 episodes of the Brady Bunch).
**
**     To use this function select the file and call choose with the field name 
**     (in quotes) optionally followed by a title for the selection window and a 
**     second field name for clarification.
**
**     If you want the selection to be filtered you can SET FILTER before 
**     calling choose.  Choose will also honor any index that might be active.
**
**   Returns:
**     Choose returns the value of the passed field of the record that the 
**     user selects.  The record pointer will be left on the selected record.
**     If the user hits Esc then a null string is returned ("")
**
**   Example:
**     Lets say you have a file of customers with the fields CUSTOMER_ID and 
**     CUSTOMER_NAME and you want the user to select a customer.  Just use the 
**     following code. . .
**
**       USE customers INDEX customers
**       the_customer = choose("Customer_ID", "Select Customer", "Customer Name)
**       IF .NOT. EMPTY(the_customer)
**          DO something WITH the_customer
**       ENDIF
**
**     That's it.  Don't worry about your screen or how big to make the 
**     window.  choose() will take care of it.

FUNCTION choose
PARAMETERS field, title, prompt_field
PRIVATE second_field, i, width

GOTO TOP
DO CASE
   CASE EOF()
        DO exclaim WITH "There are no "+TRIM(field)+"'s"
        RETURN("")
   CASE LASTREC() = 1
        RETURN(&field)
ENDCASE

DECLARE choices[LASTREC()], rec_num[LASTREC()]
          
width = LEN(&field)

second_field = .F.       
IF TYPE("prompt_field") <> "U"
   second_field = .T.
   width = width + LEN(&prompt_field) + 1
ENDIF

i = 0
DO WHILE .NOT. EOF()
   i = i+1
   
   IF second_field
      choices[i] = &field + " " + &prompt_field
   ELSE
      choices[i] = &field
   ENDIF
   rec_num[i] = RECNO()

   SKIP
ENDDO

SAVE SCREEN TO bfor_choose

@ 4,71-width,13,72 BOX frame_2 + " "
IF LEN(title) > width
   title = SUBSTR(title,1,width)
ENDIF

SET COLOR TO 0/7
@ 4,72-width+((width-LEN(title))/2) SAY title
SET COLOR TO 7/0

IF i > 9
   @ 5,72 SAY CHR(18)
ENDIF

user_choice = ACHOICE(5,72-width,12,71,choices)
RESTORE SCREEN FROM bfor_choose
IF user_choice = 0
   RETURN("")
ELSE
   GOTO rec_num[user_choice]
   RETURN(&field)
ENDIF


** Function a_choose:
**
**   Syntax:
**     A_CHOOSE(<ExpA1> [,<ExprC2>])
**
**   Purpose:
**     Let's say you have an array all filled up with values and you want your 
**     user to select one from a scrolling window.  Just call a_choose.  Like 
**     choose(), a_choose() will take care of all of the screen handling.
**
**   Returns:
**     A_Choose() returns the element number that the user selected or 0 if 
**     The user hit Esc.
**
**   Example:
**
**     array[1] = "Halibuts"
**     array[2] = "Rabbit Fish"
**      .
**      .
**      .
**     array[12] = "Flounders"
**   
**     users_choice = a_choose(array,"Fish")
**    
**     IF users_choice > 0
**        DO something_fishy WITH users_choice
**     ENDIF
**

FUNCTION a_choose 
PARAMETERS array, title 
PRIVATE title, i, width, user_choice 

width = 0
FOR i = 1 TO LEN(array)
    width = MAX(LEN(array[i]),width)
NEXT i

SAVE SCREEN TO bfor_choose

@ 4,71-width,13,72 BOX frame_2 + " "
IF LEN(title) > width
   title = SUBSTR(title,1,width)
ENDIF

SET COLOR TO 0/7
@ 4,72-width+((width-LEN(title))/2) SAY title
SET COLOR TO 7/0

IF i > 9
   @ 5,72 SAY CHR(18)
ENDIF

user_choice = ACHOICE(5,72-width,12,71,array)
RESTORE SCREEN FROM bfor_choose
IF user_choice = 0
   RETURN("")
ELSE
   RETURN(array[user_choice])
ENDIF




** Function select_file:
**
**   Syntax:
**     select_file(<ExpC>)
**
**   Purpose:
**     Allows the user to select a file from a scrolling menu box given a
**     skeleton in ExpC.  Saves and restores screen.
**
**   Returns:
**     Returns the file name or a null string if the user hits Esc.
**
**   Example:
**     the_file = select_file("*.DBF")
**     IF .NOT. EMPTY(the_file)
**        USE &the_file
**        ZAP 
**        CLOSE DATABASE
**     ENDIF
**

FUNCTION select_file
PARAMETER skeleton

DECLARE list[ADIR(skeleton)]

num_files = ADIR(skeleton,list)

IF num_files = 0
   DO exclaim WITH "There are no files."
   RETURN("")
ENDIF

SAVE SCREEN TO bfor_select

@ 4,19,16,36 BOX frame_2 + " "
the_choice = ACHOICE(5,20,15,35,list)

RESTORE SCREEN FROM bfor_select

IF the_choice = 0
   RETURN("")
ELSE
   RETURN(list[the_choice])
ENDIF



** Function c_choose:
**
**   Syntax:
**     c_choose(<ExpC0>[,ExpC1[,ExpC2,...[ExpC9]]])
**
**   Purpose:
**     This function is useful if you want the user to select among a limited
**     list of items (up to 10).   It saves and restores the screen.
**
**   Returns:
**     Returns the number of the item selected or 0 if the user hits Esc.
**
**   Example:
**     
**     the_fruit = c_choose("Apples", "Oranges", "Apricots")
**
**     IF the_fruit > 0
**        DO something WITH the_fruit
**     ENDIF
**

FUNCTION c_choose
PARAMETERS p0,p1,p2,p3,p4,p5,p6,p7,p8,p9

DECLARE choices[PCOUNT()]
max_len = 0
top = 0
left = 0
cownt = 0

FOR i = 1 TO PCOUNT()
    this_one = "p"+STR(i-1,1)
    IF TYPE(this_one) = "N"
       IF top = 0
          top = &this_one
       ELSE
          left = &this_one
       ENDIF
    ELSE
       cownt = cownt + 1
       choices[cownt] = &this_one
       max_len = MAX(LEN(choices[cownt]),max_len)
    ENDIF
NEXT i
IF top = 0
   top = 5
ENDIF
IF left = 0
   left = 10
ENDIF


SAVE SCREEN TO bfor_choose
@ top,left,7+top,max_len+left+2 BOX frame_2 + " "

value = ACHOICE(top+1,left+1,top+6,left+1+max_len,choices)
RESTORE SCREEN FROM bfor_choose
RETURN(value)




** Function choose_field:
**
**   Syntax:
**     choose_field()
**
**   Purpose:
**     Allows the user to select a field from the currently selected database.
**     It saves and restores the screen.
**
**   Returns:
**     Returns the name of the selected field or "" if the user hits Esc.
**
**   Example:
**     
**     the_field = choose_field()
**
**     IF .NOT. EMPTY(the_field)
**        DO something WITH the_field
**     ENDIF
**

FUNCTION choose_field
PRIVATE the_choice 

DECLARE field_list[FCOUNT()]

AFIELDS(field_list)

SAVE SCREEN TO bfor_choose

@ 5,50,20,61 BOX frame_2 + " "

the_choice = ACHOICE(6,51,19,60,field_list)

RESTORE SCREEN FROM bfor_choose

IF the_choice = 0
   RETURN("")
ELSE
   RETURN(field_list[the_choice])
ENDIF











**** SCR_TITLE   ***********************************************************
* Written 10-2-86 By Rob Arnold
* 
* Synopsis:
*   Puts a header on line 0.  The first parameter is left justified, the 
*   second is centeres and the third is right justified.
*
* Implementation:
*   Straightforward.
*
* Future Enhancements:
*****************************************************************************
PROCEDURE scr_title
PARAMETERS program, title, screen_code
@ 0,0 SAY REPLICATE (" ",80)
@ 0,0 SAY program
@ 0,40-(LEN(title)/2) SAY title
@ 0,79-LEN(screen_code) SAY screen_code
RETURN





****************************************************************************
* SHOWFILE.prg
* Displays text files without allowing updates.  Saves and restores screen.

PROCEDURE showfile
PARAMETER file

IF PCOUNT() = 0               && File not on command line
   RETURN
ENDIF

IF .NOT. FILE("&file")
   DO exclaim WITH TRIM(file)+" not found"
   RETURN
ENDIF

SAVE SCREEN TO bfor_show
SET CURSOR OFF
CLEAR
@ 0,0 SAY UPPER(file)
@ 1,0 TO 1,79
@ 23,0 TO 23,79
@ 24,0 SAY SPACE(7) + CHR(24) + SPACE(14) + CHR(25) + SPACE(14) +;
   + "PgUp          PgDn          Esc"

* memoedit(file,t,l,b,r,browse,user function,line length)
MEMOEDIT(MEMOREAD(file),2,0,22,79,.F.,"",80)

SET CURSOR ON
RESTORE SCREEN FROM bfor_show

RETURN




** Function center
**
**   Syntax:
**     center(<ExpC>[,ExpN])
**
**   Purpose:
**     Centers ExpC in a width of ExpN by padding with leading spaces.
**     If ExpN is omitted, 80 is assumed.
**
**   Returns:
**     Centered string.
**
**   Example:
**     
**     SET PRINT ON
**     SET CONSOLE OFF
**     ? center("Report Title", page_width)
**

FUNCTION Center
* Syntax:   Center(<expC>,<expN>)
* Centers <expC> in width of <expN> by padding with leading spaces.
* If <expN> is omitted then a width of 80 is assumed.

PRIVATE string, width
PARAMETERS string, width
IF PCOUNT() = 1               && If only string is passed
   width = 80                 && assume screen width
ENDIF
IF LEN(string) >= width       &&  Too long to center
   RETURN SUBSTR(string,1,width)
ENDIF
RETURN SPACE(INT(width/2) - INT(LEN(string)/2)) + string



FUNCTION r_justify
* Syntax:   r_justify(<expC>[,<expN>])
* Right-justifies <expC> in width of <expN> by padding with leading spaces.
* If <expN> is omitted then a width of 80 is assumed.

PRIVATE string, width
PARAMETERS string, width

IF PCOUNT() = 1               && If only string is passed
   width = 80                 && assume screen width
ENDIF
IF LEN(string) >= width       &&  Too long to justify
   RETURN SUBSTR(string,1,width)
ENDIF
RETURN SPACE(width - LEN(string)) + string



**** EXCLAIM    ************************************************************
* Written 10-2-86 By Rob Arnold
* 
* Synopsis:
*   Generic procedure to print a message and wait for the user to strike a key.
*   Don't use WAIT.  This is much better.  Saves and Restores screen.
*   
* Example:
*
*   IF something_is_wrong
*      DO exclaim WITH "Something is wrong."
*   ELSE
*      DO Its_ok 
*   ENDIF
*
* Future Enhancements:
*****************************************************************************
PROCEDURE exclaim
PARAMETER message

SAVE SCREEN TO before_exclaim
@ 22,0 CLEAR
@ 22,0,24,2 BOX frame_1
@ 23,1 SAY "!"
the_message = message + " (Press Any Key)"
@ 23,4 SAY MEMOLINE(the_message,75,1)
@ 24,4 SAY MEMOLINE(the_message,75,2)
trash = INKEY(0)
RESTORE SCREEN FROM before_exclaim
RETURN




*** CONFIRMED.PRG ************************************************************
* Written 10-2-86 By Rob Arnold For Melvin Simon & Associates
* 
* Synopsis: 
*  CONFIRMED() asks a question passed to it and returns the user's
* response as "Y" or "N".  Saves and Restores the screen.
*
* Example:
*   IF confirmed("Zap this file?")
*      ZAP
*   ENDIF
*
* Future Enhancements:
*****************************************************************************

FUNCTION confirmed
PARAMETER question

   SAVE SCREEN TO old_screen
   @ 22,0 CLEAR
   reply = "?"
   @ 22,0,24,2 BOX frame_1
   @ 23,1 SAY "?"
   the_question = question + " (Y/N)"
   IF EMPTY(MEMOLINE(the_question,75,2))
      @ 23,4 SAY the_question GET reply PICTURE "!" VALID reply $ "YN"
   ELSE
      @ 23,4 SAY MEMOLINE(the_question,75,1)
      @ 23,4 SAY MEMOLINE(the_question,75,2) GET reply PICTURE "!" VALID reply $ "YN"
   ENDIF
   READ
   RESTORE SCREEN FROM old_screen
   IF reply = "Y"
      RETURN(.T.)
   ELSE
      RETURN(.F.)
   ENDIF
RETURN(.F.)




** Function to return the number of days in the month of the date passed

FUNCTION num_days
PARAMETERS the_date
   days_in_month = 31
   IF MONTH(the_date) = 4 .OR. ;
      MONTH(the_date) = 6 .OR. ;
      MONTH(the_date) = 9 .OR. ;
      MONTH(the_date) = 11
      days_in_month = 30
   ENDIF
   IF MONTH(the_date) = 2
      days_in_month = 28
      IF INT(YEAR(the_date)/4) = YEAR(the_date)/4
         days_in_month = 29
      ENDIF
   ENDIF
RETURN days_in_month








**** DISK_WAIT.PRG ************************************************************
* Written 4-2-87 By Rob Arnold For Melvin Simon & Associates
* 
* Synopsis:
*   Generic procedure to print a insert disk message and wait for the user to 
*   strike a key.
*
* Implementation:
*
*****************************************************************************
PROCEDURE disk_wait
PARAMETER message

SAVE SCREEN TO bfor_disk
@ 22,0,24,4 BOX frame_1
@ 23,2 SAY CHR(9)+"-"
@ 23,6 SAY message + " (Press Any Key)"
trash = INKEY(0)
@ 22,0 CLEAR
RESTORE SCREEN FROM bfor_disk
RETURN
 
*ÚÄÄÄ¿
*³ 	-³  Put a disk in. . .  (Press Any Key)
*ÀÄÄÄÙ





FUNCTION printer_ready

SAVE SCREEN TO bfor_isprinter
DO WHILE .NOT. isprinter()
   @ 20,0 CLEAR
   @ 20,0 SAY "     ÚÄÄÄ¿"
   @ 21,0 SAY "     ³ ! ³"
   @ 22,0 SAY "   ÕÍÏÍÍÍÏÍÍÍÍÍ͸"
   @ 23,0 SAY "  þ³       ÜÜÜÜ ³þ  The printer is not ready (Press any key, Esc aborts)."
   @ 24,0 SAY "   ÀÄÄÄÄÄÄÄÄÄÄÄÄÙ"
   p_key = INKEY(0)
   @ 20,0 CLEAR
   IF p_key = 27
      RESTORE SCREEN FROM bfor_isprinter
      RETURN(.F.)
   ENDIF
ENDDO   

RESTORE SCREEN FROM bfor_isprinter
RETURN(.T.)






** This procedure reindexes the file indicated by the parameter by looking 
** into Alpha/three's DRF file for currently selected index's.  Note that this 
** requires that the NDX.OBJ file must be linked in in order for the index files 
** to be dBASE compatible. 
**
**
** The file should be open and currently selected despite the fact that the
** name has been passed.
**
PROCEDURE a3_reindex
PARAMETER filename

dbf_name = UPPER(TRIM(LTRIM(filename)))+".DBF"
drf_name = UPPER(TRIM(LTRIM(filename)))+".DRF"

IF .NOT. FILE(dbf_name)
   DO exclaim WITH dbf_name+" not found.  Files not reindexed."
   RETURN
ENDIF

IF .NOT. FILE(drf_name)
   DO exclaim WITH drf_name+" not found.  Files not reindexed."
   RETURN
ENDIF

handle = FOPEN(drf_name,0)

IF handle = -1
   DO exclaim WITH "Can't open "+drf_name+".  Files not reindexed."
   RETURN
ENDIF

drf_buffer = SPACE(56)
bytes_read = FREAD(handle,@drf_buffer,56)
FCLOSE(handle)
IF bytes_read <> 56
   DO exclaim WITH "Error reading "+drf_name
   RETURN
ENDIF

FOR i = 1 TO 5
    ndx_name = TRIM(SUBSTR(drf_buffer,17+((i-1)*8),8))
    IF .NOT. EMPTY(ndx_name)
       ndx_name = ndx_name + ".NDX"
       IF .NOT. FILE(ndx_name)
          DO exclaim WITH ndx_name+" not found."
       ELSE
          SET INDEX TO &ndx_name
          REINDEX
       ENDIF
    ENDIF
NEXT i

RETURN



** Interestingly, under DOS 3.x, Clipper's diskspace function returns 32Mb if 
** used on a drive when the door is not closed.  We can use this to check 
** whether a disk has been inserted.
**
** Example:
**
**  IF disk_in("Please insert a disk in drive A:")
**     DO read_a_disk
**  ENDIF

FUNCTION disk_in
PARAMETER message

DO disk_wait WITH message
IF DISKSPACE(1) > 2000000
   DO exclaim WITH "The disk is not in or the door is not closed."
   RETURN(.F.)
ELSE
   RETURN(.T.)
ENDIF





** Function str_replace:
**
** Syntax:
**   ExpC = str_replace(<ExpC2>, <ExpC3>, <ExpC4>)
**
** Purpose:
**   Replaces all occurrances of <ExpC3> with <ExpC4> in <ExpC2> and returns 
**   the modified string.
**
** Example:
**
**   a = "one, two, one, two"
**   ? str_replace(a,"one","three")
**
**   (Prints. . .)
**   three, two, three, two

FUNCTION str_replace
PARAMETERS source, to_replace, replace_with

DO WHILE to_replace $ source
   part_1 = SUBSTR(source,1,AT(to_replace,source)-1)
   part_2 = SUBSTR(source,AT(to_replace,source)+LEN(to_replace))
   source = part_1 + replace_with + part_2
ENDDO

RETURN(source)



** Validates military time
FUNCTION time_valid
PARAMETER time_string

hours = VAL(SUBSTR(time_string,1,2))
minutes = VAL(SUBSTR(time_string,4,2))

hours_ok = (hours >= 0 .AND. hours < 24)
minutes_ok = (minutes >= 0 .AND. minutes < 60)

RETURN(hours_ok .AND. minutes_ok .AND. (.NOT. EMPTY(time_string)) .AND. (.NOT. " " $ time_string))