************************************************************************
* PROCEDURE Crt_Dbf
*******************
***    Author: Rick Strahl
***            (c) West Wind Technologies, 1995
***   Contact: (503) 386-2087  / 76427.2363@compuserve.com
***  Modified: 09/01/95
***  Function: Creates a CREATE TABLE and/or set of INDEX ON
***            commands. Output to Clipboard and as a string
***            return value
***      Pass: pcMethod    -    "TABLE","INDEX","BOTH","FIELDLIST"
***                             "ARRAY" (for long Tables), "ARRAYBOTH"
***            pcTable     -    Table to work with
***            pcOutFile   -    Table name use in CREATE TABLE
***                             command. Same as pcTable is default.
***    Return: CREATE TABLE or INDEX ON strings, "" on failure
************************************************************************
PARAMETER pcMethod,pcTable,pcOutFile
PRIVATE lnFields,lcOldAlias,lcDBFStr,x,lcOutStr

#DEFINE CR CHR(13) + CHR(10)


pcMethod=IIF(TYPE("pcMethod")="C",UPPER(pcMethod),"TABLE")

*** Need at least one pararmeter
IF TYPE("pcTable")#"C"
   IF !EMPTY(ALIAS())
      pcTable=ALIAS()
   ELSE
      WAIT WINDOW "Syntax is: DO CRT_DBF with '<TABLE|TAGS>','<tablename>','<pcOutFile>'"
      RETURN ""
   ENDIF
ENDIF

pcOutFile=IIF(TYPE("pcOutFile")="C",pcOutFile,"")
IF EMPTY(pcOutFile)
   pcOutFile=pcTable
ENDIF

lcOldAlias=ALIAS()
llOpenFile=.F.

*** Use the table
IF !USED(pcTable)
   IF !FILE(pcTable+".dbf") AND !FILE(pcTable)
      WAIT WINDOW pcTable+" does not exist"
      RETURN ""
   ENDIF

   SELE 0
   USE (pcTable) AGAIN
   llOpenFile=.T.
ENDIF

pcTable = JUSTFNAME(pcTable)

SELE (pcTable)

*** Dump the fields into an array
lnFields=AFIELDS(laFields)

IF lnFields<1
   WAIT WINDOW "Error Reading Input File"
   IF !EMPTY(lcOldAlias)
      SELE (lcOldAlias)
   ENDIF
   RETURN ""
ENDIF

*** Now build a field string
lcOutStr=""

IF pcMethod="TABLE" OR pcMethod="DBF" OR ;
   pcMethod="FIELDLIST" OR pcMethod="BOTH" OR pcMethod="CLASSVARS" OR ;
   pcMethod="HELPBUILDER" OR pcMethod="DOCUMENTATION"

   *** Loop through all the fields
   FOR x=1 TO lnFields
      DO CASE
      CASE  pcMethod="CLASSVARS"     
          lcOutStr=lcOutStr+lower(laFields[x,2]) +PROPER(laFields[x,1])
      CASE pcMethod = "HELPBUILDER"
          lcOutStr = lcOutStr + "<<b>>" + PROPER(laFields[x,1]) + "<</b>>" + CR + ;
                                Proper(laFields[x,2]) + " (" + TRANS(laFields[x,3]) + IIF(laFields[x,4] > 0," " + TRANS(laFields[x,4]),"") + ")" + CR +CR
          LOOP                      
      CASE pcMethod = "DOCUMENTATION"
          lcOutStr = lcOutStr + PROPER(laFields[x,1]) + CR + ;
                                Proper(laFields[x,2]) + " (" + TRANS(laFields[x,3]) + IIF(laFields[x,4] > 0," " + TRANS(laFields[x,4]),"") + ")" + CR +CR
          LOOP                      
      CASE  pcMethod="FIELDLIST"
         lcOutStr=lcOutStr+PROPER(laFields[x,1])
      OTHERWISE
         lcTemp=""
         *** Add width for character
         IF laFields[x,2]="C"
            lcTemp="("+ALLTRIM(STR(laFields[x,3],3))+")"
         ENDIF

         *** add width and decimals for numerics and float
         IF laFields[x,2]="N" OR laFields[x,2]="F"
            lcTemp="("+ALLTRIM(STR(laFields[x,3],3))+","+ALLTRIM(STR(laFields[x,4],3))+")"
         ENDIF

         *** Now create the name and type clause and if nec add width and decs.
         lcOutStr=lcOutStr+"   "+PADR(laFields[x,1],12)+laFields[x,2]+" "+lcTemp

      ENDCASE   && plFieldList

      *** don't add semicolon and CR on last field
      IF x # lnFields
            lcOutStr=lcOutStr+",;"+CR
      ENDIF
    ENDFOR

   *** Enclose the field string in parenthesis
   IF !INLIST(pcMethod,"FIELDLIST","CLASSVARS","DOCUMENTATION","HELPBUILDER")
      lcOutStr="( "+lcOutStr+")"
      lcOutStr="CREATE CURSOR "+(pcOutFile)+" ;"+CR+lcOutStr
   ENDIF
ENDIF

*** CREATE TABLE FROM ARRAY statement
IF pcMethod=="ARRAY" OR pcMethod="ARRAYBOTH"
   *** Loop through all the fields
   FOR x=1 TO lnFields
       *** Now create the name and type clause and if nec add width and decs.
       lcOutStr=lcOutStr+"lxFields["+str(x,3)+",1]='"+laFields[x,1]+"'"+CR+;
                         "lxFields["+Str(x,3)+",2]='"+laFields[x,2]+"'"+CR+;
                         "lxFields["+Str(x,3)+",3]="+STR(laFields[x,3],3)+CR+;
                         "lxFields["+Str(x,3)+",4]="+STR(laFields[x,4],3)+CR

   ENDFOR

   *** Enclose the field string in parenthesis
   IF pcMethod#"FIELDLIST"
      lcOutStr=CR+"DIMENSION lxFields["+STR(lnFields,3)+",4]"+CR+CR+lcOutStr+CR+;
               "CREATE TABLE "+pcOutFile+" FROM ARRAY lxFields"+CR+CR
   ENDIF
ENDIF

IF  pcMethod="BOTH" OR pcMethod="TAGS" OR ;
      pcMethod="CDX" OR pcMethod="INDEX" OR pcMethod="ARRAYBOTH"

   IF pcMethod="BOTH"
      lcOutStr=lcOutStr+CR+CR
   ENDIF

   x = 1
   DO WHILE !EMPTY(TAG(x))
      lcOutStr = lcOutStr + ;
         "INDEX ON "+LOWER(SYS(14,x))+;
         " TAG "+LOWER(TAG(x))+;
         IIF(!EMPTY(SYS(2021,x))," FOR "+SYS(2021,x),"")

      IF DESCENDING(pcTable, x)
         lcOutStr = lcOutStr + " DESCENDING"
      ENDIF
      IF UNIQUE(pcTable, x)
         lcOutStr = lcOutStr + " UNIQUE"
      ENDIF

      lcOutStr=lcOutStr+CR
      x = x + 1
   ENDDO

   *** Strip off last CR
   IF RIGHT(lcOutStr,1)=CR
      lcOutStr=LEFT(lcOutStr,LEN(lcOutStr)-1)
   ENDIF
ENDIF

*** Also copy to cliptext
_CLIPTEXT=lcOutStr

*** Clear table
IF llOpenFile AND USED(pcTable)
   USE
ENDIF

*** reset old workarea
IF USED(lcOldAlias)
   SELE (lcOldAlias)
ENDIF

RETURN lcOutstr
