home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / bcklib2.zip / STANDARD.PRG < prev    next >
Text File  |  1993-01-16  |  13KB  |  294 lines
  1. /*
  2.     The source code contained within this file is protected under the
  3.     laws of the United States of America and by International Treaty.
  4.     Unless otherwise noted, the source contained herein is:
  5.  
  6.     Copyright (c)1990, 1991, 1992 BecknerVision Inc - All Rights Reserved
  7.  
  8.     Written by John Wm Beckner        THIS NOTICE MUST NOT BE REMOVED
  9.     BecknerVision Inc
  10.     PO Box 11945                      DISTRIBUTE ONLY WITH SHAREWARE
  11.     Winston-Salem NC 27116            VERSION OF THIS PRODUCT.
  12.     Fax: 919/760-1003
  13.  
  14. */
  15.  
  16. #include "beckner.inc"
  17.  
  18. FUNCTION Standard()
  19.    LOCAL cProgram := space(8), cFunction := 'Main'+space(11), cCoprYear := '1991'
  20.    LOCAL cCoprName := 'BecknerVision Inc', nSource, nMax, lMain := .y., aPrompt
  21.    LOCAL cAuthor := 'John Wm Beckner            ', cTitle := space(30), aGet
  22.    LOCAL cDBF, aFldName, aType, aWidth, aDec, aPicture, aValid, aWhen, cScrInfo
  23.  
  24.    SET KEY -8 to pCtrlW
  25.    CLS
  26.    @ 1, 0 say "Create STANDARD program with BECKNER.LIB"
  27.    @ 2, 0 say "Copyright (c)1991 BecknerVision Inc - All Rights Reserved"
  28.    @ 4, 0 say 'Program title ................' get cTitle
  29.    @ row()+1, 0 say 'Program name .................' get cProgram picture '@!'
  30.    @ row()+1, 0 say 'Main function name ...........' get cFunction
  31.    @ row()+1, 0 say 'Copyright year ...............' get cCoprYear pict '9999'
  32.    @ row()+1, 0 say 'Copyright name ...............' get cCoprName
  33.    @ row()+1, 0 say "Author's name ................" get cAuthor
  34.    READ
  35.    cTitle    := trim(cTitle)
  36.    cProgram  := trim(cProgram)
  37.    cFunction := trim(cFunction)
  38.    cCoprName := trim(cCoprName)
  39.    cAuthor   := trim(cAuthor)
  40.    nSource   := fCreate(cProgram+".PRG")
  41.    fWrite(nSource, "/*"+CRLF+CRLF)
  42.    fWrite(nSource, "  Program title: "+cTitle+CRLF)
  43.    fWrite(nSource, "    Source name: "+cProgram+CRLF)
  44.    fWrite(nSource, "   Date created: "+dtoc(date())+CRLF)
  45.    fWrite(nSource, "         Author: "+cAuthor+CRLF)
  46.    fWrite(nSource, "         Notice: Copyright (c)"+cCoprYear+" "+cCoprName)
  47.    fWrite(nSource, " - All Rights Reserved"+CRLF+CRLF)
  48.    fWrite(nSource, "   Written with the assistance of the ")
  49.    fWrite(nSource, "Standard Program Creator"+CRLF)
  50.    fWrite(nSource, "   Copyright (c)1991 BecknerVision Inc - All Rights")
  51.    fWrite(nSource, " Reserved"+CRLF+CRLF)
  52.    fWrite(nSource, "*/"+CRLF+CRLF)
  53.    fWrite(nSource, "#define ENDWHILE END"+CRLF)
  54.    fWrite(nSource, "#define LOOPING .y."+CRLF+CRLF)
  55.    fWrite(nSource, "FUNCTION "+cFunction+"()"+CRLF)
  56.    fWrite(nSource, "LOCAL cTemp, aOptions := {}, cScreen"+CRLF)
  57.    fWrite(nSource, "PRIVATE aScrInfo := {}"+CRLF)
  58.    fWrite(nSource, "SET EXCLUSIVE off"+CRLF)
  59.    fWrite(nSource, "SET DELETED on"+CRLF)
  60.    fWrite(nSource, "SET SCOREBOARD off"+CRLF)
  61.    fWrite(nSource, "SET KEY -1 to pHelp"+CRLF)
  62.    fWrite(nSource, "SET KEY -8 to pCtrlW"+CRLF)
  63.    fWrite(nSource, "CLS"+CRLF)
  64.    fWrite(nSource, "vBackground(chr(177))"+CRLF)
  65.    fWrite(nSource, "vTitle({'"+cTitle+"',;"+CRLF)
  66.    fWrite(nSource, "         'Copyright (c)"+cCoprYear+" "+cCoprName)
  67.    fWrite(nSource, " - All Rights Reserved',;"+CRLF)
  68.    fWrite(nSource, "         'Written by "+cAuthor+"',;"+CRLF)
  69.    fWrite(nSource, "         'Version 1.0'})"+CRLF)
  70.    fWrite(nSource, "vMessageOn('Opening/Creating Data Files')"+CRLF)
  71.    WHILE LOOPING
  72.       aFldName := {}
  73.       aType    := {}
  74.       aWidth   := {}
  75.       aDec     := {}
  76.       aPrompt  := {}
  77.       aGet     := {}
  78.       aPicture := {}
  79.       aValid   := {}
  80.       aWhen    := {}
  81.       @ 4,0 clear to 24,79
  82.       cDBF     := space(8)
  83.       @ 4,0 say 'Database filename (press <enter> when done):' get cDBF;
  84.       picture '@!'
  85.       READ
  86.       IF empty(cDBF)
  87.          EXIT
  88.       ENDIF
  89.       cScrInfo := ""
  90.       cDBF     := trim(cDBF)
  91.       @ 5, 0 say 'Field Name  Type Width Dec Prompt               Get? Picture'
  92.       @ 5, col()+1 say '    Valid     When'
  93.       SetPos(5, 0)
  94.       WHILE LOOPING
  95.          aAdd(aFldName, space(10))
  96.          aAdd(aType, "C")
  97.          aAdd(aWidth, 10)
  98.          aAdd(aDec, 0)
  99.          aAdd(aPrompt, space(30))
  100.          aAdd(aGet, .y.)
  101.          aAdd(aPicture, space(50))
  102.          aAdd(aValid, space(200))
  103.          aAdd(aWhen, space(200))
  104.          @ row()+1, 0 get aFldName[(nMax := len(aFldName))]
  105.          @ row(), 12 get aType[nMax] picture '@!A';
  106.          valid aType[nMax]$'CLNDM' when !empty(aFldName[nMax])
  107.          @ row(), 17 get aWidth[nMax] picture '99999';
  108.          when !aType[nMax]$'DLM'.and.!empty(aFldName[nMax])
  109.          @ row(), 23 get aDec[nMax] picture '999';
  110.          when aType[nMax]='N'.and.!empty(aFldName[nMax])
  111.          @ row(), 27 get aPrompt[nMax] picture '@S20' when !empty(aFldName[nMax])
  112.          @ row(), 48 get aGet[nMax] picture 'Y' when !empty(aFldName[nMax])
  113.          @ row(), 52 get aPicture[nMax] picture '@S9' when !empty(aFldName[nMax])
  114.          @ row(), 62 get aValid[nMax] picture '@S9' when !empty(aFldName[nMax])
  115.          @ row(), 72 get aWhen[nMax] picture '@S9' when !empty(aFldName[nMax])
  116.          vCursSave()
  117.          READ
  118.          vCursRest()
  119.          vCursSave()
  120.          @ row()+1, 0 say aFldName[nMax]
  121.          @ row(), 12 say aType[nMax]
  122.          @ row(), 17 say aWidth[nMax] picture '99999'
  123.          @ row(), 23 say aDec[nMax] picture '999'
  124.          @ row(), 27 say left(aPrompt[nMax], 20)
  125.          @ row(), 47 say iif(aGet[nMax], 'Yes', ' No')
  126.          @ row(), 52 say left(aPicture[nMax], 9)
  127.          @ row(), 62 say left(aValid[nMax], 9)
  128.          @ row(), 72 say left(aWhen[nMax], 9)
  129.          vCursRest()
  130.          IF empty(aFldName[nMax])
  131.             EXIT
  132.          ENDIF
  133.          IF row()=maxrow()
  134.             vScroll(6, 0, maxrow(), 79)
  135.             SetPos(maxrow()-1, 0)
  136.          ENDIF
  137.          cScrInfo += trim(aPrompt[nMax])+'       //'+iif(aGet[nMax], 'G/', 'S/')
  138.          cScrInfo += trim(aPicture[nMax])+'      //'+trim(aValid[nMax])+'//'
  139.          cScrInfo += trim(aWhen[nMax])+'         ///'
  140.       ENDWHILE
  141.       fWrite(nSource, "IF !file('"+cDBF+".DBF')"+CRLF)
  142.       fWrite(nSource, "   cTemp := '"+cDBF+"/'"+CRLF)
  143.       nMax--
  144.       nMax--
  145.       FOR nCtr := 1 to nMax
  146.          fWrite(nSource, "   cTemp += '"+trim(aFldName[nCtr])+"/"+aType[nCtr]+"/")
  147.          fWrite(nSource, iif(aType[nCtr]$'NC', ltrim(str(aWidth[nCtr]))+'/', NIL))
  148.          iif(aType[nCtr]='N', fWrite(nSource, ltrim(str(aDec[nCtr]))+'/'), NIL)
  149.          fWrite(nSource, "'"+CRLF)
  150.       NEXT
  151.       nMax++
  152.       fWrite(nSource, "   cTemp += '"+trim(aFldName[nCtr])+"/"+aType[nMax]+"/")
  153.       fWrite(nSource, iif(aType[nMax]='M', "10", iif(aType[nMax]='D', "8",;
  154.       iif(aType[nMax]='L', "1", ltrim(str(aWidth[nCtr]))+''))))
  155.       iif(aType[nMax]='N', fWrite(nSource, '/'+ltrim(str(aDec[nCtr]))), NIL)
  156.       fWrite(nSource, "'"+CRLF)
  157.       fWrite(nSource, "   fCreateDBF(cTemp)"+CRLF)
  158.       fWrite(nSource, "ENDIF"+CRLF)
  159.       fWrite(nSource, "aAdd(aScrInfo, '"+iif(lMain, "Main", cProgram)+"/")
  160.       fWrite(nSource, left(cScrInfo, len(cScrInfo)-3)+"')"+CRLF)
  161.       fWrite(nSource, "fShare('"+cDBF)
  162.       IF lMain
  163.          lMain := .n.
  164.          fWrite(nSource, "', 'Main')"+CRLF)
  165.       ELSE
  166.          fWrite(nSource, "')"+CRLF)
  167.       ENDIF
  168.       cTemp := ""
  169.       aFldName := {}
  170.       aType := {}
  171.       @ 5, 0 clear to 24, 79
  172.       @ 5, 10 say 'Index Filename      Expression'
  173.       SetPos(5, 0)
  174.       WHILE LOOPING
  175.          aAdd(aFldName, space(8))
  176.          aAdd(aType, space(254))
  177.          vCursSave()
  178.          @ row()+1, 10 get aFldName[(nMax := len(aFldName))] picture '@!'
  179.          @ row(), 30 get aType[nMax] picture '@S45'
  180.          READ
  181.          aType[nMax] := trim(aType[nMax])
  182.          vCursRest()
  183.          IF empty(aFldName[nMax])
  184.             EXIT
  185.          ENDIF
  186.          aFldName[nMax] := trim(aFldName[nMax])
  187.          IF row()=maxrow()
  188.             vScroll(6, 0, maxrow(), 79)
  189.             SetPos(maxrow()-1, 0)
  190.          ENDIF
  191.       ENDWHILE
  192.       nMax--
  193.       FOR nCtr := 1 to nMax
  194.          cTemp += aFldName[nCtr]+", "
  195.          fWrite(nSource, "IF !file('"+aFldName[nCtr]+".NTX')"+CRLF)
  196.          fWrite(nSource, "   INDEX on "+aType[nCtr]+" to "+aFldName[nCtr]+CRLF)
  197.          fWrite(nSource, "ENDIF"+CRLF)
  198.       NEXT
  199.       iif(nMax>0, fWrite(nSource, "SET INDEX to "+left(cTemp, len(cTemp)-2);
  200.       +CRLF), NIL)
  201.    ENDWHILE
  202.    fWrite(nSource, "vMessageOff()"+CRLF)
  203.    fWrite(nSource, "CLS"+CRLF)
  204.    fWrite(nSource, "SetColor('n+/w')"+CRLF)
  205.    fWrite(nSource, "vBackground(chr(177))"+CRLF)
  206.    fWrite(nSource, "SetColor('bg+/b,b/w')"+CRLF)
  207.    fWrite(nSource, "aOptions := {'Add', 'Edit', 'Get', 'Next', 'Prior', 'Browse'")
  208.    fWrite(nSource, ", 'Reports',;"+CRLF)
  209.    fWrite(nSource, "      'Maintenance', 'Quit'}"+CRLF)
  210.    fWrite(nSource, "WHILE LOOPING"+CRLF)
  211.    fWrite(nSource, "   SELECT Main"+CRLF)
  212.    fWrite(nSource, "   cScreen := vSave()"+CRLF)
  213.    fWrite(nSource, "   pOnDo(vMenu('T', aOptions), {'stAdd(aScrInfo)', ")
  214.    fWrite(nSource, "'stEdit()', 'rFullGet()',;"+CRLF)
  215.    fWrite(nSource, "      'rNextRec()', 'rPriorRec()', 'stBrowse()', ")
  216.    fWrite(nSource, "'stReports()',;"+CRLF)
  217.    fWrite(nSource, "      'stMaint()', 'pQuit()'})"+CRLF)
  218.    fWrite(nSource, "   vRestore(cScreen)"+CRLF)
  219.    fWrite(nSource, "ENDWHILE"+CRLF+CRLF)
  220.    fWrite(nSource, "FUNCTION stAdd(aScrInfo)"+CRLF)
  221.    fWrite(nSource, "LOCAL aField, aPrompt := {}, aSayGet := {}, aPicture := {}, ")
  222.    fWrite(nSource, "aValid := {}, aWhen := {}"+CRLF)
  223.    fWrite(nSource, "LOCAL nElement, cTemp, nCtr := 0"+CRLF)
  224.    fWrite(nSource, "IF (nElement := aScan(aScrInfo, alias()))=0"+CRLF)
  225.    fWrite(nSource, "   RETURN NIL"+CRLF)
  226.    fWrite(nSource, "ENDIF"+CRLF)
  227.    fWrite(nSource, "cTemp := aScrInfo[nElement]"+CRLF)
  228.    fWrite(nSource, "sParse(@cTemp)"+CRLF)
  229.    fWrite(nSource, "WHILE !empty(cTemp)"+CRLF)
  230.    fWrite(nSource, "   aAdd(aField, FieldName(++nCtr))"+CRLF)
  231.    fWrite(nSource, "   aAdd(aPrompt, sParse(@cTemp, ' //'))"+CRLF)
  232.    fWrite(nSource, "   aAdd(aSayGet, sParse(@cTemp))"+CRLF)
  233.    fWrite(nSource, "   aAdd(aPicture, sParse(@cTemp, ' //'))"+CRLF)
  234.    fWrite(nSource, "   aAdd(aValid, sParse(@cTemp, ' //'))"+CRLF)
  235.    fWrite(nSource, "   aAdd(aWhen, sParse(@cTemp, ' ///'))"+CRLF)
  236.    fWrite(nSource, "ENDWHILE"+CRLF)
  237.    fWrite(nSource, "fFullAdd(aField, aPrompt, aSayGet, aPicture, aValid, aWhen)")
  238.    fWrite(nSource, CRLF)
  239.    fWrite(nSource, "RETURN NIL"+CRLF+CRLF)
  240.    fWrite(nSource, "FUNCTION stEdit()"+CRLF)
  241.    fWrite(nSource, "fLockRec()"+CRLF)
  242.    fWrite(nSource, "@ maxrow(), 0"+CRLF)
  243.    fWrite(nSource, "@ maxrow(), 0 say 'Record #'+ltrim(transform(recno(),")
  244.    fWrite(nSource, " '99,999'))"+CRLF)
  245.    fWrite(nSource, "fDataEdit()"+CRLF)
  246.    fWrite(nSource, "UNLOCK"+CRLF)
  247.    fWrite(nSource, "RETURN NIL"+CRLF+CRLF)
  248.    fWrite(nSource, "FUNCTION stBrowse()"+CRLF)
  249.    fWrite(nSource, "fLockFile()"+CRLF)
  250.    fWrite(nSource, "Browse(1, 0, maxrow(), maxcol())"+CRLF)
  251.    fWrite(nSource, "UNLOCK"+CRLF)
  252.    fWrite(nSource, "RETURN NIL"+CRLF+CRLF)
  253.    fWrite(nSource, "FUNCTION stReports()"+CRLF)
  254.    fWrite(nSource, "LOCAL cScreen, aRC, nOption := 1"+CRLF)
  255.    fWrite(nSource, "cScreen := vSave()"+CRLF)
  256.    fWrite(nSource, "set(36, maxrow())"+CRLF)
  257.    fWrite(nSource, "set(37, .y.)"+CRLF)
  258.    fWrite(nSource, "WHILE LOOPING"+CRLF)
  259.    fWrite(nSource, "   aRC := vWindow(3, 20, .y., 'REPORTS')"+CRLF)
  260.    fWrite(nSource, "   @ aRC[1], aRC[2] prompt 'Report Generator    ' ")
  261.    fWrite(nSource, "message 'Invokes the Beckner Report Generator'"+CRLF)
  262.    fWrite(nSource, "   @ row()+1, aRC[2] prompt 'Forms Generator     ' ")
  263.    fWrite(nSource, "message 'Invokes the Beckner Forms Generator'"+CRLF)
  264.    fWrite(nSource, "   @ row()+1, aRC[2] prompt 'Word processor     ' ")
  265.    fWrite(nSource, "message 'Invokes the Beckner Word Processor'"+CRLF)
  266.    fWrite(nSource, "   MENU to nOption"+CRLF)
  267.    fWrite(nSource, "   IF nOption=0"+CRLF)
  268.    fWrite(nSource, "      RETURN NIL"+CRLF)
  269.    fWrite(nSource, "   ENDIF"+CRLF)
  270.    fWrite(nSource, "   pOnDo(nOption, {'BecknerRL()', 'BecknerFG()', ")
  271.    fWrite(nSource, "'BecknerWP()'})"+CRLF)
  272.    fWrite(nSource, "   vRestore(cScreen)"+CRLF)
  273.    fWrite(nSource, "ENDWHILE"+CRLF+CRLF)
  274.    fWrite(nSource, "FUNCTION stMaint()"+CRLF+CRLF)
  275.    fWrite(nSource, "*EOP"+CRLF)
  276.    fClose(nSource)
  277.    nSource := fCreate("STC.BAT")
  278.    fWrite(nSource, "echo off"+CRLF)
  279.    fWrite(nSource, "cls"+CRLF)
  280.    fWrite(nSource, "clipper "+cProgram+" -n -m -w"+CRLF)
  281.    fWrite(nSource, "if errorlevel 1 goto errs"+CRLF)
  282.    fWrite(nSource, "rtlink fi "+cProgram+", beckner2, beckner3, beckner4 ")
  283.    fWrite(nSource, "lib beckner pll base50"+CRLF)
  284.    fWrite(nSource, "cls"+CRLF)
  285.    fWrite(nSource, "echo To abort press {ctrl-C} or To run program"+CRLF)
  286.    fWrite(nSource, "pause"+CRLF)
  287.    fWrite(nSource, cProgram)
  288.    fClose(nSource)
  289.    CLS
  290.    ?? "Created source code file "+cProgram+".PRG"
  291.    ? "To compile/link/run, enter STC"
  292.    ?
  293. ENDFUNCTION
  294.