home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a106 / 2.ddi / DBFSELEC.PR_ / DBFSELEC.bin
Encoding:
Text File  |  1994-04-28  |  34.2 KB  |  1,026 lines
  1. *       ╓─────────────────────────────────────────────────────────╖
  2. *       ║                                                         ║
  3. *       ║ 03/20/92            DBFSELEC.PRG               09:16:44 ║
  4. *       ║                                                         ║
  5. *       ╟─────────────────────────────────────────────────────────╢
  6. *       ║                                                         ║
  7. *       ║ Author's Name                                           ║
  8. *       ║                                                         ║
  9. *       ║ Copyright (c) 1992 Company Name                         ║
  10. *       ║ Address                                                 ║
  11. *       ║ City,     Zip                                           ║
  12. *       ║                                                         ║
  13. *       ║ Description:                                            ║
  14. *       ║ This program was automatically generated by GENSCRN.    ║
  15. *       ║                                                         ║
  16. *       ╙─────────────────────────────────────────────────────────╜
  17.  
  18.  
  19. #REGION 0
  20. REGIONAL m.currarea, m.talkstat, m.compstat
  21.  
  22. IF SET("TALK") = "ON"
  23.     SET TALK OFF
  24.     m.talkstat = "ON"
  25. ELSE
  26.     m.talkstat = "OFF"
  27. ENDIF
  28. m.compstat = SET("COMPATIBLE")
  29. SET COMPATIBLE FOXPLUS
  30.  
  31. *       ╓─────────────────────────────────────────────────────────╖
  32. *       ║                                                         ║
  33. *       ║                    Window definitions                   ║
  34. *       ║                                                         ║
  35. *       ╙─────────────────────────────────────────────────────────╜
  36. *
  37.  
  38. IF NOT WEXIST("dbfselec")
  39.     DEFINE WINDOW dbfselec ;
  40.         FROM INT((SROW()-17)/2),INT((SCOL()-36)/2) ;
  41.         TO INT((SROW()-17)/2)+16,INT((SCOL()-36)/2)+35 ;
  42.         TITLE " Related Databases " ;
  43.         FLOAT ;
  44.         NOCLOSE ;
  45.         SHADOW ;
  46.         DOUBLE ;
  47.         COLOR SCHEME 5
  48. ENDIF
  49.  
  50. IF NOT WEXIST("_q440jvysz")
  51.     DEFINE WINDOW _q440jvysz ;
  52.         FROM INT((SROW()-11)/2),INT((SCOL()-40)/2) ;
  53.         TO INT((SROW()-11)/2)+10,INT((SCOL()-40)/2)+39 ;
  54.         FLOAT ;
  55.         NOCLOSE ;
  56.         SHADOW ;
  57.         DOUBLE ;
  58.         COLOR SCHEME 5
  59. ENDIF
  60.  
  61.  
  62. *       ╓─────────────────────────────────────────────────────────╖
  63. *       ║                                                         ║
  64. *       ║             DBFSELEC Setup Code - SECTION 2             ║
  65. *       ║                                                         ║
  66. *       ╙─────────────────────────────────────────────────────────╜
  67. *
  68.  
  69. #REGION 1
  70. * Save the databases, etc. that are open so that we can restore
  71. * the environment properly if the user opens a lot of databases
  72. * (by adding them to the relations) and then presses cancel.
  73. CREATE VIEW dbfselec.vue
  74.  
  75. IF TYPE('DBFLIST') = 'U'
  76.    IF m.nextdbf = 0
  77.  
  78.       DO initdbflist
  79.  
  80.       * Default main database to the one that is currently open
  81.       IF !EMPTY(ALIAS())
  82.          dbflist[1,m.cstemnum] = ALIAS()
  83.          dbflist[1,m.cdbfnum]  = FULLPATH(DBF())
  84.          m.nextdbf = 2
  85.       ELSE
  86.          * If none currently open (shouldn't happen), prompt for one
  87.          m.newdbf = GETFILE("DBF","Database to open:")
  88.          IF !EMPTY(m.newdbf)
  89.             dbflist[1,m.cstemnum] = juststem(m.newdbf)
  90.             dbflist[1,m.cdbfnum] = m.newdbf
  91.  
  92.             IF USED(dbflist[1,m.cstemnum])
  93.                SELECT (dbflist[1,m.cstemnum])
  94.             ELSE
  95.                SELECT 0
  96.                USE (m.newdbf)
  97.             ENDIF
  98.          ELSE
  99.             RETURN
  100.          ENDIF
  101.          m.nextdbf = 1
  102.       ENDIF
  103.       m.dbfselec = 1
  104.    ENDIF
  105. ELSE   && figure out which is the next available DBFlist slot
  106.    FOR i = 1 TO m.numareas
  107.       IF EMPTY(dbflist[i,m.cstemnum]) OR dbflist[i,m.cstemnum] = '\'
  108.          m.nextdbf = i
  109.          EXIT
  110.       ENDIF
  111.    ENDFOR
  112. ENDIF
  113.  
  114. * Store the current dbflist in "origdbflist" so that we can restore it
  115. * if "cancel" is pressed.  Also store the current "nextdbf" value.
  116. RELEASE origdbflist                        && if it already exists
  117. PUBLIC origdbflist[m.numareas,m.numcols]
  118. =ACOPY(dbflist,origdbflist)
  119. orignextdbf = nextdbf
  120.  
  121.  
  122.  
  123. *       ╓─────────────────────────────────────────────────────────╖
  124. *       ║                                                         ║
  125. *       ║             GETDEST Setup Code - SECTION 2              ║
  126. *       ║                                                         ║
  127. *       ╙─────────────────────────────────────────────────────────╜
  128. *
  129.  
  130. #REGION 2
  131. skipvar = .T.
  132. repbut = 1   && default button choice
  133. repdest = SPACE(40)
  134. okbut = 1
  135.  
  136.  
  137. *       ╓─────────────────────────────────────────────────────────╖
  138. *       ║                                                         ║
  139. *       ║                 DBFSELEC Screen Layout                  ║
  140. *       ║                                                         ║
  141. *       ╙─────────────────────────────────────────────────────────╜
  142. *
  143.  
  144. #REGION 1
  145. IF WVISIBLE("dbfselec")
  146.     ACTIVATE WINDOW dbfselec SAME
  147. ELSE
  148.     ACTIVATE WINDOW dbfselec NOSHOW
  149. ENDIF
  150. @ 0,1 GET dbfselec ;
  151.     PICTURE "@&N" ;
  152.     FROM dbflist ;
  153.     SIZE 14,16 ;
  154.     DEFAULT 1 ;
  155.     WHEN _q440jvz5n() ;
  156.     VALID _q440jvz95() ;
  157.     COLOR SCHEME 6
  158. @ 1,22 GET addclr ;
  159.     PICTURE "@*VN \<Add;C\<lear" ;
  160.     SIZE 1,10,1 ;
  161.     DEFAULT 1 ;
  162.     VALID _q440jvzf6()
  163. @ 11,22 GET okbut ;
  164.     PICTURE "@*VT \!\<OK;\?\<Cancel" ;
  165.     SIZE 1,10,1 ;
  166.     DEFAULT 1 ;
  167.     VALID _q440jvzwt()
  168. @ 5,22 TO 5,31
  169. @ 7,22 GET arrange ;
  170.     PICTURE "@*HN A\<rrange" ;
  171.     SIZE 1,10,1 ;
  172.     DEFAULT 1 ;
  173.     VALID _q440jw038()
  174. @ 9,22 TO 9,31
  175. @ 14,4 GET tree1 ;
  176.     PICTURE "@*HN \<Show Tree" ;
  177.     SIZE 1,11,1 ;
  178.     DEFAULT 1 ;
  179.     VALID _q440jw0q9()
  180.  
  181.  
  182.  
  183.  
  184. *       ╓─────────────────────────────────────────────────────────╖
  185. *       ║                                                         ║
  186. *       ║                  GETDEST Screen Layout                  ║
  187. *       ║                                                         ║
  188. *       ╙─────────────────────────────────────────────────────────╜
  189. *
  190.  
  191. #REGION 2
  192. IF WVISIBLE("_q440jvysz")
  193.     ACTIVATE WINDOW _q440jvysz SAME
  194. ELSE
  195.     ACTIVATE WINDOW _q440jvysz NOSHOW
  196. ENDIF
  197. @ 1,13 GET repbut ;
  198.     PICTURE "@*RVN \<Screen;\<Printer;\<File" ;
  199.     SIZE 1,11,0 ;
  200.     DEFAULT 1 ;
  201.     VALID _q440jw0wi()
  202. @ 4,9 GET repdest ;
  203.     SIZE 1,28 ;
  204.     DEFAULT " " ;
  205.     VALID _q440jw0zx()
  206. @ 6,13 GET okbut ;
  207.     PICTURE "@*VT \!\<OK" ;
  208.     SIZE 1,10,1 ;
  209.     DEFAULT 1
  210. @ 0,9 SAY "Report destination:"
  211. @ 8,13 GET canclbut ;
  212.     PICTURE "@*HT \?\<Cancel" ;
  213.     SIZE 1,10,1 ;
  214.     DEFAULT 1
  215. @ 4,2 GET rfile ;
  216.     PICTURE "@*HN \<File" ;
  217.     SIZE 1,6,1 ;
  218.     DEFAULT 1
  219.  
  220. IF NOT WVISIBLE("_q440jvysz")
  221.     ACTIVATE WINDOW _q440jvysz
  222. ENDIF
  223. IF NOT WVISIBLE("dbfselec")
  224.     ACTIVATE WINDOW dbfselec
  225. ENDIF
  226.  
  227.  
  228. READ CYCLE MODAL ;
  229.     ACTIVATE _q440jw0v5() ;
  230.     DEACTIVATE _q440jw14p() ;
  231.     SHOW _q440jw0v8()
  232.  
  233. RELEASE WINDOW _q440jvysz
  234. RELEASE WINDOW dbfselec
  235.  
  236. #REGION 0
  237. IF m.talkstat = "ON"
  238.     SET TALK ON
  239. ENDIF
  240. IF m.compstat = "ON"
  241.     SET COMPATIBLE ON
  242. ENDIF
  243.  
  244.  
  245. *       ╓─────────────────────────────────────────────────────────╖
  246. *       ║                                                         ║
  247. *       ║                  DBFSELEC Cleanup Code                  ║
  248. *       ║                                                         ║
  249. *       ╙─────────────────────────────────────────────────────────╜
  250. *
  251.  
  252. #REGION 1
  253. * Get rid of the tree window if it is still around
  254. IF WEXIST('treewind')
  255.    RELEASE WINDOW treewind
  256. ENDIF
  257.  
  258. *!*****************************************************************
  259. *!
  260. *!      Procedure: ARRSAVE
  261. *!
  262. *!*****************************************************************
  263. PROCEDURE arrsave
  264. * Save arrangement of windows and return to dbfselect screen
  265.  
  266. * Set exit flag for READ VALID
  267. arrexflg = .T.
  268.  
  269. * Record window coordinates and release all the application windows
  270. m.ctrlrow = WLROW('CTRL')
  271. m.ctrlcol = WLCOL('CTRL')
  272. RELEASE WINDOW ctrl
  273.  
  274. FOR i = 1 TO m.numareas
  275.    IF !EMPTY(dbflist[i,m.cstemnum]) AND dbflist[i,m.cstemnum] <> '\'
  276.       dbflist[i,m.srownum] = ALLTRIM(STR(WLROW(dbflist[i,m.cstemnum]),3))
  277.       dbflist[i,m.scolnum] = ALLTRIM(STR(WLCOL(dbflist[i,m.cstemnum]),3))
  278.       dbflist[i,m.erownum] = ;
  279.          ALLTRIM(STR(VAL(dbflist[i,m.srownum]);
  280.          +1+wrow(dbflist[i,m.cstemnum]),3))
  281.       dbflist[i,m.ecolnum] = ;
  282.          ALLTRIM(STR(VAL(dbflist[i,m.scolnum]);
  283.          +1+wcol(dbflist[i,m.cstemnum]),3))
  284.       RELEASE WINDOW (dbflist[i,m.cstemnum])
  285.    ENDIF
  286.    dbflist[i,m.arranged] = "Y"
  287. ENDFOR
  288.  
  289. * Restore environment
  290. POP MENU _msysmenu
  291. SHOW WINDOW appgen, dbfselec
  292. ACTIVATE WINDOW dbfselec
  293.  
  294. CLEAR READ
  295.  
  296. RETURN
  297.  
  298.  
  299.  
  300. *!*****************************************************************
  301. *!
  302. *!      Procedure: ARREXIT
  303. *!
  304. *!*****************************************************************
  305. PROCEDURE arrexit
  306. * Exit without saving window positions
  307.  
  308. * Set exit flag for READ VALID
  309. arrexflg = .T.
  310.  
  311. * Release all the application windows
  312. RELEASE WINDOW ctrl
  313. FOR i = 1 TO m.numareas
  314.    IF !EMPTY(dbflist[i,m.cstemnum]) AND dbflist[i,m.cstemnum] <> '\'
  315.       RELEASE WINDOW (dbflist[i,m.cstemnum])
  316.    ENDIF
  317. ENDFOR
  318.  
  319. * Restore environment
  320. POP MENU _msysmenu
  321. SHOW WINDOW appgen, dbfselec
  322. ACTIVATE WINDOW dbfselec
  323.  
  324. CLEAR READ
  325.  
  326. RETURN
  327.  
  328.  
  329. *!*****************************************************************
  330. *!
  331. *!      Procedure: HASCHILD
  332. *!
  333. *!*****************************************************************
  334. FUNCTION haschild
  335. * Does the database at position "dbfnum" of DBFLIST have a child
  336. * table?
  337. parameter dbfnum
  338. PRIVATE dbfnum, i
  339.  
  340. * See if another database has this one as its parent
  341. FOR m.i = 1 TO m.numareas
  342.    IF ALLTRIM(dbflist[m.i,m.pdbfnum]) ;
  343.          == ALLTRIM(dbflist[m.dbfnum,m.cstemnum])
  344.       RETURN .T.
  345.    ENDIF
  346. ENDFOR
  347. RETURN .F.
  348.  
  349. *!*****************************************************************
  350. *!
  351. *!      Procedure: SHOWTREE
  352. *!
  353. *!*****************************************************************
  354. PROCEDURE showtree
  355. parameter dbfnum, indent
  356. PRIVATE dbfnum, indent
  357. * Recursive routine to display a tree diagram of database relationships.
  358.  
  359. * The window in which to display the tree must be activated before
  360. * calling showtree.
  361.  
  362. * First display this database in its correct position on the tree.
  363. IF WEXIST('treewind')
  364.    treestr = SPACE(m.indent*3);
  365.       +IIF(m.indent<>0,CHR(192)+CHR(196)+CHR(26),'');
  366.       +dbflist[m.dbfnum,m.cstemnum]
  367.    end_row = MIN(WLROW('treewind') + 2 + m.nextdbf, SROWS()-1)
  368.    IF LEN(treestr) >= WCOLS() - 2
  369.       s_col = WLCOL('treewind')
  370.       * Move the window to the left if necessary
  371.       IF s_col + LEN(treestr) + 3 >= SCOLS() - 3
  372.          s_col = SCOLS() - LEN(treestr) - 6
  373.       ENDIF
  374.       ZOOM WINDOW treewind NORM ;
  375.          FROM WLROW('treewind'),s_col TO end_row, s_col+LEN(treestr)+4
  376.    ENDIF
  377.    ? treestr
  378. ELSE
  379.    RETURN
  380. ENDIF
  381.  
  382. * Find any children of this database and display them
  383. FOR i = 1 TO m.numareas
  384.    IF ALLTRIM(dbflist[m.i,m.pdbfnum]) ;
  385.          == ALLTRIM(dbflist[m.dbfnum,m.cstemnum])
  386.       DO showtree WITH i, indent + 1
  387.    ENDIF
  388. ENDFOR
  389.  
  390.  
  391.  
  392. *       ╓─────────────────────────────────────────────────────────╖
  393. *       ║                                                         ║
  394. *       ║                  GETDEST Cleanup Code                   ║
  395. *       ║                                                         ║
  396. *       ╙─────────────────────────────────────────────────────────╜
  397. *
  398.  
  399. #REGION 2
  400. skipvar = .F.
  401.  
  402.  
  403. *       ╓─────────────────────────────────────────────────────────╖
  404. *       ║                                                         ║
  405. *       ║ _Q440JVZ5N           dbfselec WHEN                      ║
  406. *       ║                                                         ║
  407. *       ║ Function Origin:                                        ║
  408. *       ║                                                         ║
  409. *       ║ From Screen:         DBFSELEC,     Record Number:    2  ║
  410. *       ║ Variable:            dbfselec                           ║
  411. *       ║ Called By:           WHEN Clause                        ║
  412. *       ║ Object Type:         List                               ║
  413. *       ║ Snippet Number:      1                                  ║
  414. *       ║                                                         ║
  415. *       ╙─────────────────────────────────────────────────────────╜
  416. *
  417. FUNCTION _q440jvz5n     &&  dbfselec WHEN
  418. #REGION 1
  419. IF dbfselec = 0
  420.    dbfselec = m.nextdbf - 1
  421.    SHOW GET dbfselec
  422. ENDIF
  423.  
  424. DO CASE
  425. CASE dbfselec = 1
  426.    SHOW GET addclr,2 DISABLE
  427. CASE haschild(dbfselec)
  428.    SHOW GET addclr,2 DISABLE
  429. OTHERWISE
  430.    SHOW GET addclr,2 ENABLE
  431. ENDCASE
  432.  
  433.  
  434. *       ╓─────────────────────────────────────────────────────────╖
  435. *       ║                                                         ║
  436. *       ║ _Q440JVZ95           dbfselec VALID                     ║
  437. *       ║                                                         ║
  438. *       ║ Function Origin:                                        ║
  439. *       ║                                                         ║
  440. *       ║ From Screen:         DBFSELEC,     Record Number:    2  ║
  441. *       ║ Variable:            dbfselec                           ║
  442. *       ║ Called By:           VALID Clause                       ║
  443. *       ║ Object Type:         List                               ║
  444. *       ║ Snippet Number:      2                                  ║
  445. *       ║                                                         ║
  446. *       ╙─────────────────────────────────────────────────────────╜
  447. *
  448. FUNCTION _q440jvz95     &&  dbfselec VALID
  449. #REGION 1
  450. DO CASE
  451. CASE m.dbfselec = 0  && ignore a null selection
  452.    * This shouldn't be possible because of the WHEN code,
  453.    * but put the validation test in just to be sure.
  454.    RETURN .F.
  455. CASE m.dbfselec = 1
  456.    WAIT WINDOW "Main database." NOWAIT
  457. CASE m.dbfselec > 1
  458.    m.newdbf     = dbflist[m.dbfselec,m.cstemnum]
  459.    m.childfld   = dbflist[m.dbfselec,m.cfldnum]
  460.    m.childdbf   = dbflist[m.dbfselec,m.cdbfnum]
  461.    m.parentfld  = dbflist[m.dbfselec,m.pfldnum]
  462.    m.igncase    = .T.
  463.    m.relstr     = dbflist[m.dbfselec,m.relstrnum]
  464.    m.parentdbf  = dbflist[m.dbfselec,m.pdbfnum]
  465.    m.addmode    = .F.    && we're editing an existing one
  466.  
  467.    * Find out how this database relates to the other ones.
  468.    * Relselec will return an empty "childfld" if cancel was
  469.    * pressed.
  470.    DO relselec.spr WITH m.newdbf, m.childdbf, m.childfld, m.parentfld, ;
  471.       m.igncase, m.relstr, m.parentdbf, m.addmode
  472.    IF !EMPTY(m.childfld)
  473.       * Record data about this child DBF on the DBFLIST
  474.       dbflist[m.dbfselec,m.cstemnum]  = juststem(m.newdbf)
  475.       dbflist[m.dbfselec,m.relstrnum] = m.relstr
  476.       dbflist[m.dbfselec,m.pfldnum]   = m.parentfld
  477.       dbflist[m.dbfselec,m.cfldnum]   = m.childfld
  478.       dbflist[m.dbfselec,m.cdbfnum]   = m.childdbf
  479.       dbflist[m.dbfselec,m.pdbfnum]   = m.parentdbf
  480.    ENDIF
  481. ENDCASE
  482.  
  483.  
  484. *       ╓─────────────────────────────────────────────────────────╖
  485. *       ║                                                         ║
  486. *       ║ _Q440JVZF6           addclr VALID                       ║
  487. *       ║                                                         ║
  488. *       ║ Function Origin:                                        ║
  489. *       ║                                                         ║
  490. *       ║ From Screen:         DBFSELEC,     Record Number:    3  ║
  491. *       ║ Variable:            addclr                             ║
  492. *       ║ Called By:           VALID Clause                       ║
  493. *       ║ Object Type:         Push Button                        ║
  494. *       ║ Snippet Number:      3                                  ║
  495. *       ║                                                         ║
  496. *       ╙─────────────────────────────────────────────────────────╜
  497. *
  498. FUNCTION _q440jvzf6     &&  addclr VALID
  499. #REGION 1
  500. DO CASE
  501. CASE m.addclr = 1   && add another database to the pot
  502.    IF m.nextdbf >= m.numareas
  503.       WAIT WINDOW "There are no available work areas left." NOWAIT
  504.       RETURN
  505.    ENDIF
  506.  
  507.    * Only accept DBF files, unless user cancels
  508.    m.newdbf = "XXX"   && any value other than blank or a DBF file
  509.    DO WHILE !EMPTY(m.newdbf) AND justext(m.newdbf) <> 'DBF'
  510.       m.newdbf = GETFILE('DBF','Database to open:')
  511.    ENDDO
  512.  
  513.    IF !EMPTY(m.newdbf)
  514.       * Check for duplicate DBF stem name
  515.       FOR i = 1 TO m.numareas
  516.          IF juststem(m.newdbf) == dbflist[i,m.cstemnum]
  517.             WAIT WINDOW "Duplicate database names are not allowed." NOWAIT
  518.             RETURN
  519.          ENDIF
  520.       ENDFOR
  521.  
  522.       m.childfld   = ""
  523.       m.childdbf   = m.newdbf
  524.       m.newdbf     = juststem(m.newdbf)
  525.       m.parentfld  = ""
  526.       m.igncase    = .T.
  527.       m.relstr     = ""
  528.       m.parentdbf  = ""
  529.  
  530.       * Find out how this database relates to the other ones.
  531.       * Relselec will return an empty "childfld" if cancel was
  532.       * pressed.
  533.       DO relselec.spr WITH m.newdbf, m.childdbf, m.childfld, m.parentfld, ;
  534.          m.igncase, m.relstr, m.parentdbf, .T.
  535.  
  536.       IF !EMPTY(m.childfld)  && true unless user cancelled RelSelec
  537.          * Open the new child database
  538.          IF USED(m.newdbf)
  539.             SELECT (m.newdbf)
  540.          ELSE
  541.             SELECT 0
  542.             USE (m.childdbf)
  543.          ENDIF
  544.  
  545.          * See if we need to add a CDX or a tag on the relation field
  546.          DO makecdx WITH (m.childdbf), (m.childfld)
  547.  
  548.          * Record data about this child DBF on the DBFLIST
  549.          dbflist[m.nextdbf,m.cstemnum]  = juststem(m.newdbf)
  550.          dbflist[m.nextdbf,m.relstrnum] = m.relstr
  551.          dbflist[m.nextdbf,m.pfldnum]   = m.parentfld
  552.          dbflist[m.nextdbf,m.cfldnum]   = m.childfld
  553.          dbflist[m.nextdbf,m.cdbfnum]   = m.childdbf
  554.          dbflist[m.nextdbf,m.pdbfnum]   = m.parentdbf
  555.  
  556.          * Come up with reasonable default positions for the database
  557.          * browse window.  The "Arrange" option is how they will
  558.          * usually be set.
  559.          IF m.nextdbf > 2
  560.             dbflist[m.nextdbf,m.srownum] ;
  561.                = ALLTRIM(STR(VAL(dbflist[m.nextdbf-1,m.srownum])+1,3))
  562.             dbflist[m.nextdbf,m.scolnum] ;
  563.                = ALLTRIM(STR(VAL(dbflist[m.nextdbf,m.scolnum])+1,3))
  564.          ELSE
  565.             dbflist[m.nextdbf,m.srownum] = "1"
  566.             dbflist[m.nextdbf,m.scolnum] = "1"
  567.          ENDIF
  568.          dbflist[m.nextdbf,m.erownum] ;
  569.             = ALLTRIM(STR(VAL(dbflist[m.nextdbf,m.srownum])+5,3))
  570.          dbflist[m.nextdbf,m.ecolnum] ;
  571.             = ALLTRIM(STR(SCOLS()-1,3))
  572.  
  573.          m.nextdbf  = m.nextdbf + 1
  574.          m.dbfselec = m.nextdbf - 1
  575.          SHOW GET arrange ENABLE
  576.          SHOW GET addclr,2 ENABLE    && enable the "Clear" button
  577.       ENDIF
  578.    ENDIF
  579. CASE m.addclr = 2    && clear this dbf
  580.    DO CASE
  581.    CASE m.dbfselec = 0   && choice was invalid
  582.       RETURN .F.
  583.    CASE m.dbfselec = 1
  584.       WAIT WINDOW "You cannot clear the main database." NOWAIT
  585.       RETURN
  586.    ENDCASE
  587.  
  588.    * See if this database has a child.  If so, don't allow it to be
  589.    * cleared.  The clear button is also usually dimmed if the current
  590.    * dbflist item has a child.
  591.    IF haschild(m.dbfselec) AND !EMPTY(m.dbfselec)
  592.       WAIT WINDOW "You cannot clear a database that has related databases." NOWAIT
  593.       RETURN
  594.    ENDIF
  595.  
  596.    * Clear the DBF, assuming we are pointed at a valid DBF name.
  597.    IF !EMPTY(dbflist[m.dbfselec,m.cstemnum]) AND dbflist[m.dbfselec,m.cstemnum] <> '\'
  598.       * Close the database, if it is open (it should be)
  599.       IF USED((TRIM(dbflist[m.dbfselec,m.cstemnum])))
  600.          SELECT (TRIM(dbflist[m.dbfselec,m.cstemnum]))
  601.          USE
  602.       ENDIF
  603.       dbflist[m.dbfselec,m.cstemnum] = SPACE(25)
  604.       DO CASE
  605.       CASE m.nextdbf = 1                && no databases to close
  606.       CASE m.dbfselec = m.nextdbf       && close the last one in the list
  607.          m.nextdbf = m.nextdbf - 1
  608.       OTHERWISE                         && close some other database
  609.          = ADEL(dbflist,m.dbfselec)
  610.          dbflist[m.numareas,m.cstemnum] = '\'  && disable this list item
  611.          FOR i = 2 TO numcols
  612.             dbflist[m.numareas,i] = ''
  613.          ENDFOR
  614.          m.nextdbf = m.nextdbf - 1
  615.       ENDCASE
  616.       m.dbfselec = m.nextdbf - 1
  617.  
  618.       SHOW GET dbfselec
  619.    ENDIF
  620.    IF m.nextdbf = 1
  621.       SHOW GET arrange DISABLE
  622.    ENDIF
  623. ENDCASE
  624. SHOW GETS
  625.  
  626.  
  627. *       ╓─────────────────────────────────────────────────────────╖
  628. *       ║                                                         ║
  629. *       ║ _Q440JVZWT           okbut VALID                        ║
  630. *       ║                                                         ║
  631. *       ║ Function Origin:                                        ║
  632. *       ║                                                         ║
  633. *       ║ From Screen:         DBFSELEC,     Record Number:    4  ║
  634. *       ║ Variable:            okbut                              ║
  635. *       ║ Called By:           VALID Clause                       ║
  636. *       ║ Object Type:         Push Button                        ║
  637. *       ║ Snippet Number:      4                                  ║
  638. *       ║                                                         ║
  639. *       ╙─────────────────────────────────────────────────────────╜
  640. *
  641. FUNCTION _q440jvzwt     &&  okbut VALID
  642. #REGION 1
  643. IF okbut = 1
  644.    IF relateddbfs()
  645.       * Save the database relationships
  646.       IF m.storersc
  647.          * Tell user what is going on
  648.          WAIT WINDOW "Saving database relations and window positions." NOWAIT
  649.  
  650.          DO putdbflist WITH dbflist[1,m.cstemnum]
  651.       ENDIF
  652.  
  653.       WAIT CLEAR
  654.    ENDIF
  655. ELSE
  656.    * Restore original DBFLIST array
  657.    =ACOPY(origdbflist,dbflist)
  658.    m.nextdbf = m.orignextdbf
  659.    RELEASE origdbflist
  660.  
  661.    * Restore incoming environment
  662.    IF FILE('dbfselec.vue')
  663.       SET VIEW TO dbfselec.vue
  664.    ENDIF
  665. ENDIF
  666.  
  667. * Drop the view file
  668. IF FILE('dbfselec.vue')
  669.    DELETE FILE dbfselec.vue
  670. ENDIF
  671.  
  672.  
  673. *       ╓─────────────────────────────────────────────────────────╖
  674. *       ║                                                         ║
  675. *       ║ _Q440JW038           arrange VALID                      ║
  676. *       ║                                                         ║
  677. *       ║ Function Origin:                                        ║
  678. *       ║                                                         ║
  679. *       ║ From Screen:         DBFSELEC,     Record Number:    6  ║
  680. *       ║ Variable:            arrange                            ║
  681. *       ║ Called By:           VALID Clause                       ║
  682. *       ║ Object Type:         Push Button                        ║
  683. *       ║ Snippet Number:      5                                  ║
  684. *       ║                                                         ║
  685. *       ╙─────────────────────────────────────────────────────────╜
  686. *
  687. FUNCTION _q440jw038     &&  arrange VALID
  688. #REGION 1
  689. PUSH MENU _msysmenu
  690.  
  691. RELEASE arrexflg   && causes upcoming Foundation read to terminate
  692. PUBLIC  arrexflg
  693. arrexflg = .F.
  694.  
  695. tree_up = WVISIBLE('treewind')
  696.  
  697. HIDE WINDOW appgen, dbfselec
  698. IF WEXIST('treewind')
  699.    HIDE WINDOW treewind
  700. ENDIF
  701.  
  702. * Set up "arrange" pad on main menu
  703. DEFINE PAD arrange OF _msysmenu PROMPT "\<Arrange" KEY ALT+A,"" COLOR SCHEME 3
  704. ON PAD arrange OF _msysmenu ACTIVATE POPUP arngpop
  705.  
  706. DEFINE POPUP arngpop MARGIN RELATIVE SHADOW COLOR SCHEME 4
  707. DEFINE BAR 1 OF arngpop PROMPT "\<Save"
  708. DEFINE BAR 2 OF arngpop PROMPT "\<Exit"
  709.  
  710. * Disable the Window and Edit pads while we're in Arrange
  711. DEFINE PAD _mwindow OF _msysmenu PROMPT "\Window"
  712. DEFINE PAD _medit OF _msysmenu PROMPT "\Edit"
  713.  
  714. ON SELECTION BAR 1 OF arngpop DO arrsave
  715. ON SELECTION BAR 2 OF arngpop DO arrexit
  716.  
  717. * Save the screen and start the arranging from a blank screen
  718. SAVE SCREEN TO arr_scrn
  719. ACTIVATE SCREEN
  720. CLEAR
  721.  
  722. * Define window for control panel
  723. IF m.ctrlrow <> 1 OR m.ctrlcol <> 1
  724.    DEFINE WINDOW ctrl ;
  725.       FROM m.ctrlrow,m.ctrlcol TO m.ctrlrow+2,m.ctrlcol+72 ;
  726.       TITLE "Control panel" ;
  727.       GROW FLOAT NOZOOM NOCLOSE
  728. ELSE
  729.    DEFINE WINDOW ctrl FROM SROWS()-3,3 TO SROWS()-1,scol()-3 GROW FLOAT NOZOOM NOCLOSE ;
  730.       TITLE "Control panel"
  731. ENDIF
  732. ACTIVATE WINDOW ctrl
  733.  
  734. * Figure out how wide the main database screen will be
  735. IF EMPTY(m.scxname) OR !FILE(m.scxname)
  736.    * If a screen hasn't been defined yet, look at the database fields
  737.    SELECT (dbflist[1,m.cstemnum])
  738.    m.maxlen  = 0
  739.    m.maxheight = FCOUNT() + 4
  740.    m.maxcapt = 0
  741.    FOR i = 1 TO FCOUNT()
  742.       m.maxlen  = MAX(m.maxlen,FSIZE(FIELD(i)))  && max field length
  743.       m.maxcapt = MAX(m.maxcapt,LEN(FIELD(i))+2) && max field name length
  744.    ENDFOR
  745.    m.maxlen = m.maxlen + m.maxcapt + 4   && allow for borders
  746. ELSE         && otherwise, look to the SCX itself
  747.    SELECT 0
  748.    USE (scxname) AGAIN ALIAS fxscxnme
  749.    maxlen    = fxscxnme->WIDTH
  750.    maxheight = fxscxnme->HEIGHT
  751.    USE
  752. ENDIF
  753.  
  754. * Determine position for main database window and define window
  755. DO CASE
  756. CASE UPPER(dbflist[1,m.arranged]) = "N"
  757.    * No screen position yet defined for the main database.  Center it,
  758.    * unless there are lots of related databases.  If there are, put
  759.    * it closer to the top of the screen.
  760.    IF m.nextdbf < 3
  761.       start_row = SROWS()/2-m.maxheight/2
  762.       end_row   = m.start_row + m.maxheight - 1
  763.       start_col = SCOLS()/2-m.maxlen/2
  764.       end_col   = m.start_col + m.maxlen - 1
  765.    ELSE
  766.       start_row = 1
  767.       end_row   = m.start_row + m.maxheight - 1
  768.       start_col = SCOLS()/2-m.maxlen/2
  769.       end_col   = m.start_col + m.maxlen - 1
  770.    ENDIF
  771. OTHERWISE   && show it where the user put it last
  772.    start_row = VAL(dbflist[1,m.srownum])
  773.    end_row   = m.start_row + m.maxheight - 1
  774.    start_col = VAL(dbflist[1,m.scolnum])
  775.    end_col   = m.start_col + m.maxlen - 1
  776. ENDCASE
  777.  
  778. * Define the blank window for the main database
  779. DEFINE WINDOW (dbflist[1,m.cstemnum]) ;
  780.    FROM m.start_row,m.start_col TO m.end_row,m.end_col ;
  781.    TITLE dbflist[1,m.cstemnum] ;
  782.    NOGROW FLOAT NOZOOM NOCLOSE ;
  783.    COLOR SCHEME 1
  784.  
  785. * Define windows for child databases
  786. FOR i = 2 TO m.numareas
  787.    IF !EMPTY(dbflist[i,m.cstemnum]) AND dbflist[i,m.cstemnum] <> '\'
  788.       IF dbflist[i,m.arranged] = "N"
  789.          * Try to place browse windows immediately beneath main screen
  790.          win_height = 6   && minimum height of a BROWSE window
  791.          IF end_row + (i-2)*(m.win_height+1) + 2 < SROWS() - 3
  792.             ws_row = m.end_row + (i-2)*(m.win_height+1) + 2
  793.             ws_col = 1
  794.             we_row = m.ws_row + m.win_height - 1
  795.             we_col = SCOLS()-2
  796.          ELSE     && put the browse windows in the upper left of the screen
  797.             ws_row = i
  798.             ws_col = i
  799.             we_row = MIN(m.ws_row+m.win_height,SROWS())
  800.             we_col = SCOLS()-1
  801.          ENDIF
  802.       ELSE
  803.          ws_row = VAL(dbflist[i,m.srownum])
  804.          ws_col = VAL(dbflist[i,m.scolnum])
  805.          we_row = VAL(dbflist[i,m.erownum])
  806.          we_col = VAL(dbflist[i,m.ecolnum])
  807.       ENDIF
  808.       DEFINE WINDOW (dbflist[i,m.cstemnum]) ;
  809.          FROM m.ws_row,m.ws_col TO m.we_row,m.we_col ;
  810.          SYSTEM ;
  811.          TITLE dbflist[i,m.cstemnum] ;
  812.          GROW FLOAT NOZOOM NOCLOSE ;
  813.          COLOR SCHEME 10
  814.       ACTIVATE WINDOW (dbflist[i,m.cstemnum])
  815.    ENDIF
  816. ENDFOR
  817.  
  818. * Activate the main window
  819. ACTIVATE WINDOW (dbflist[1,m.cstemnum])
  820.  
  821. * The read terminates when the user selects "Save" or "Exit" from the menu
  822. READ VALID m.arrexflg
  823.  
  824. IF tree_up AND WEXIST('treewind')
  825.    SHOW WINDOW treewind
  826. ENDIF
  827. RELEASE arrexflg
  828.  
  829. RESTORE SCREEN FROM arr_scrn
  830.  
  831.  
  832. *       ╓─────────────────────────────────────────────────────────╖
  833. *       ║                                                         ║
  834. *       ║ _Q440JW0Q9           tree1 VALID                        ║
  835. *       ║                                                         ║
  836. *       ║ Function Origin:                                        ║
  837. *       ║                                                         ║
  838. *       ║ From Screen:         DBFSELEC,     Record Number:    8  ║
  839. *       ║ Variable:            tree1                              ║
  840. *       ║ Called By:           VALID Clause                       ║
  841. *       ║ Object Type:         Push Button                        ║
  842. *       ║ Snippet Number:      6                                  ║
  843. *       ║                                                         ║
  844. *       ╙─────────────────────────────────────────────────────────╜
  845. *
  846. * Hide the tree diagram if it is visible; display it if it isn't
  847. FUNCTION _q440jw0q9     &&  tree1 VALID
  848. #REGION 1
  849. IF WVISIBLE('treewind')
  850.    RELEASE WINDOW treewind
  851.    SHOW GET tree1,1 PROMPT "\<Show tree"
  852. ELSE
  853.    IF m.nextdbf <= 1
  854.       WAIT WINDOW "No tree to show!" NOWAIT
  855.    ELSE
  856.       start_row = 3
  857.       end_row   = MIN(start_row + 2 + m.nextdbf, SROWS()-1)
  858.       start_col = 1
  859.       end_col   = 20
  860.       DEFINE WINDOW treewind ;
  861.          FROM start_row,start_col TO end_row,end_col ;
  862.          TITLE "Database tree" ;
  863.          SYSTEM FLOAT NOZOOM NOCLOSE NOGROW ;
  864.          COLOR SCHEME 10
  865.       ACTIVATE WINDOW treewind NOSHOW
  866.       SET CURSOR OFF
  867.       DO showtree WITH 1,0
  868.       ACTIVATE WINDOW treewind
  869.       SHOW GET tree1,1 PROMPT "\<Hide tree"
  870.    ENDIF
  871. ENDIF
  872.  
  873.  
  874. *       ╓─────────────────────────────────────────────────────────╖
  875. *       ║                                                         ║
  876. *       ║ _Q440JW0WI           repbut VALID                       ║
  877. *       ║                                                         ║
  878. *       ║ Function Origin:                                        ║
  879. *       ║                                                         ║
  880. *       ║ From Screen:         GETDEST,     Record Number:    2   ║
  881. *       ║ Variable:            repbut                             ║
  882. *       ║ Called By:           VALID Clause                       ║
  883. *       ║ Object Type:         Radio Button                       ║
  884. *       ║ Snippet Number:      7                                  ║
  885. *       ║                                                         ║
  886. *       ╙─────────────────────────────────────────────────────────╜
  887. *
  888. FUNCTION _q440jw0wi     &&  repbut VALID
  889. #REGION 2
  890. IF repbut <> 3
  891.    SHOW GET rfile DISABLE
  892.    SHOW GET repdest DISABLE
  893. ELSE
  894.    SHOW GET rfile ENABLE
  895.    SHOW GET repdest ENABLE
  896. ENDIF
  897. SHOW GETS
  898.  
  899.  
  900. *       ╓─────────────────────────────────────────────────────────╖
  901. *       ║                                                         ║
  902. *       ║ _Q440JW0ZX           repdest VALID                      ║
  903. *       ║                                                         ║
  904. *       ║ Function Origin:                                        ║
  905. *       ║                                                         ║
  906. *       ║ From Screen:         GETDEST,     Record Number:    3   ║
  907. *       ║ Variable:            repdest                            ║
  908. *       ║ Called By:           VALID Clause                       ║
  909. *       ║ Object Type:         Field                              ║
  910. *       ║ Snippet Number:      8                                  ║
  911. *       ║                                                         ║
  912. *       ╙─────────────────────────────────────────────────────────╜
  913. *
  914. FUNCTION _q440jw0zx     &&  repdest VALID
  915. #REGION 2
  916. m.repdest = PADR(ALLTRIM(UPPER(m.repdest)),40)
  917.  
  918. IF EMPTY(m.repdest)
  919.    SHOW GET okbut DISABLE
  920. ELSE
  921.    SHOW GET okbut ENABLE
  922. ENDIF
  923. SHOW GETS
  924.  
  925.  
  926. *       ╓─────────────────────────────────────────────────────────╖
  927. *       ║                                                         ║
  928. *       ║ _Q440JW0V5           Read Level Activate                ║
  929. *       ║                                                         ║
  930. *       ║ Function Origin:                                        ║
  931. *       ║                                                         ║
  932. *       ║ From Screen:         Multiple Screens                   ║
  933. *       ║ Called By:           READ Statement                     ║
  934. *       ║ Snippet Number:      9                                  ║
  935. *       ║                                                         ║
  936. *       ╙─────────────────────────────────────────────────────────╜
  937. *
  938. FUNCTION _q440jw0v5     && Read Level Activate
  939. *
  940. * Activate Code from screen: DBFSELEC
  941. *
  942. #REGION 1
  943. IF nextdbf = 1
  944.    SHOW GET arrange DISABLE
  945. ELSE
  946.    SHOW GET arrange ENABLE
  947. ENDIF
  948.  
  949. *
  950. * Activate Code from screen: GETDEST
  951. *
  952. #REGION 2
  953. IF repbut = 3
  954.    SHOW GET repdest ENABLE
  955. ELSE
  956.    SHOW GET repdest DISABLE
  957. ENDIF
  958.  
  959.  
  960. *       ╓─────────────────────────────────────────────────────────╖
  961. *       ║                                                         ║
  962. *       ║ _Q440JW14P           Read Level Deactivate              ║
  963. *       ║                                                         ║
  964. *       ║ Function Origin:                                        ║
  965. *       ║                                                         ║
  966. *       ║ From Screen:         Multiple Screens                   ║
  967. *       ║ Called By:           READ Statement                     ║
  968. *       ║ Snippet Number:      10                                 ║
  969. *       ║                                                         ║
  970. *       ╙─────────────────────────────────────────────────────────╜
  971. *
  972. FUNCTION _q440jw14p     && Read Level Deactivate
  973. *
  974. * Deactivate Code from screen: GETDEST
  975. *
  976. #REGION 2
  977. ?? CHR(7)
  978. RETURN .F.
  979.  
  980.  
  981. *       ╓─────────────────────────────────────────────────────────╖
  982. *       ║                                                         ║
  983. *       ║ _Q440JW0V8           Read Level Show                    ║
  984. *       ║                                                         ║
  985. *       ║ Function Origin:                                        ║
  986. *       ║                                                         ║
  987. *       ║ From Screen:         Multiple Screens                   ║
  988. *       ║ Called By:           READ Statement                     ║
  989. *       ║ Snippet Number:      11                                 ║
  990. *       ║                                                         ║
  991. *       ╙─────────────────────────────────────────────────────────╜
  992. *
  993. FUNCTION _q440jw0v8     && Read Level Show
  994. PRIVATE currwind
  995. STORE WOUTPUT() TO currwind
  996. *
  997. * Show Code from screen: DBFSELEC
  998. *
  999. #REGION 1
  1000. IF WVISIBLE('treewind')
  1001.    ACTIVATE WINDOW treewind NOSHOW
  1002.    CLEAR
  1003.    SET CURSOR OFF
  1004.    DO showtree WITH 1,0
  1005.    ACTIVATE WINDOW treewind
  1006. ENDIF
  1007.  
  1008. *
  1009. * Show Code from screen: GETDEST
  1010. *
  1011. #REGION 2
  1012. IF repbut = 3
  1013.    SHOW GET repdest ENABLE
  1014. ELSE
  1015.    SHOW GET repdest DISABLE
  1016. ENDIF
  1017.  
  1018. IF repbut = 3 AND EMPTY(repdest)
  1019.    SHOW GET okbut DISABLE
  1020. ELSE
  1021.    SHOW GET okbut ENABLE
  1022. ENDIF
  1023.  
  1024. IF NOT EMPTY(currwind)
  1025.     ACTIVATE WINDOW (currwind) SAME
  1026. ENDIF