home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / TEMPLGEN / PROPROC.INC < prev    next >
Encoding:
Text File  |  1990-02-20  |  11.6 KB  |  401 lines
  1. <<* Proproc.inc *>>
  2.  
  3. <<procedure GenProcStandard>>
  4. <<begin>>
  5.  
  6. * --- This procedure is called when Goto... is selected from the Go menu
  7.  
  8. PROCEDURE dogoto
  9. where = 0
  10. recnum = 0
  11. okcancel = 0
  12. getnum = .F.
  13.  
  14. * --- Define and activate Goto options
  15.  
  16. @ 1,2 SAY 'Goto: '
  17. @ 0,10 TO 9,26
  18. @ 1,13 PROMPT ' \<Top     '
  19. @ 3,13 PROMPT ' \<Bottom  '
  20. @ 5,13 PROMPT ' \<Record  '
  21. @ 7,13 PROMPT ' \<Skip    '
  22. MENU TO where
  23. DO CASE                                                             
  24.  
  25.     *--- Escape out of dialog
  26.     CASE where = 0
  27.         RETURN
  28.  
  29.     *--- Goto first record
  30.     CASE where = 1
  31.         GO TOP
  32.  
  33.     *--- Goto last record
  34.     CASE where = 2
  35.         GO BOTTOM
  36.  
  37.     *--- Goto specified record number
  38.     CASE where = 3
  39.         recnum = 0 
  40.         @ 5,29 GET recnum PICTURE '@Z 99999999'
  41.         READ
  42.         DEACTIVATE WINDOW ALL
  43.         IF recnum < 1
  44.             RETURN
  45.         ENDIF
  46.         IF recnum > RECCOUNT()
  47.             DO alert WITH msg_range 
  48.         ELSE
  49.             GO recnum
  50.         ENDIF
  51.  
  52.     *--- Skip specified number of records
  53.     CASE where = 4
  54.         recnum = 0 
  55.         @ 7,29 GET recnum PICTURE '@Z 99999999'
  56.         READ
  57.         DEACTIVATE WINDOW ALL
  58.         mrecno = RECNO() 
  59.         SKIP recnum 
  60.         IF EOF() .OR. BOF()
  61.             DO alert WITH msg_range 
  62.             GOTO mrecno
  63.         ENDIF
  64. ENDCASE
  65. RETURN
  66.  
  67. * ---  This procedure is called to display a message 
  68.  
  69. PROCEDURE alert
  70. PARAMETER mess
  71. =SYS(2002)
  72. ACTIVATE WINDOW alert
  73. CLEAR
  74. @ 2,0 SAY PADC(mess,WCOLS())
  75. WAIT ''
  76. DEACTIVATE WINDOW alert
  77. =SYS(2002,1)
  78. RETURN
  79.  
  80. * --- Procedure called when a Yes/No response is needed
  81.  
  82. PROCEDURE alert2
  83. PARAMETER answer,mess1
  84. ACTIVATE WINDOW alert
  85. CLEAR
  86. @ 1,0 SAY PADC(mess1,WCOLS())
  87. DO WHILE .T. 
  88.     @ 3,3 PROMPT '<   \<Yes    >'  
  89.     @ 3,34 PROMPT CHR(174)+'    \<No    '+CHR(175) 
  90.     MENU TO answer
  91.     IF answer <> 0
  92.         EXIT
  93.     ENDIF
  94. ENDDO       
  95. DEACTIVATE WINDOW alert
  96. RETURN
  97.  
  98. * --- Procedure called when a program is busy processing
  99.  
  100. PROCEDURE working
  101. PARAMETER mstatus
  102. IF mstatus
  103.     SET BLINK ON
  104.     SET COLOR TO &mflash
  105.     @ 24,70 SAY ' Working..'
  106.     SET COLOR TO 
  107. ELSE
  108.     SET BLINK OFF
  109.     @ 24,70
  110. ENDIF
  111. RETURN
  112.  
  113. * --- Procedure called when the Locate option is selected from the Go menu
  114.  
  115. PROCEDURE dolocate
  116. PARAMETER expr
  117. PRIVATE oldrecnum
  118. IF EOF()
  119.     SKIP - 1
  120. ENDIF
  121. oldrecnum = RECNO()
  122. LOCATE FOR &expr
  123. IF EOF()
  124.     DO alert WITH msg_loc1 
  125.     GOTO oldrecnum
  126.     continueon = .F. 
  127.     expr = '' 
  128. ELSE
  129.     continueon = .T. 
  130. ENDIF
  131. RETURN
  132.  
  133. * --- Procedure called when Continue is chosen from the Go menu
  134.  
  135. PROCEDURE docont
  136. PRIVATE oldrecnum
  137. oldrecnum = RECNO()
  138. CONTINUE
  139. IF EOF()
  140.     DO alert WITH msg_eof 
  141.     GOTO oldrecnum
  142.     continueon = .F. 
  143. ELSE
  144.     continueon = .T. 
  145. ENDIF
  146. RETURN
  147.  
  148. * --- Procedure called when an execution error occurs
  149.  
  150. PROCEDURE doerror
  151. PARAMETER errnum,errmes
  152. <<if ismultials>>
  153. temparea = STR(dbfarea)
  154. <<endif>>
  155. answer = 1
  156. sterrnum = SPACE(1)+ALLTRIM(STR(errnum))+SPACE(1)
  157. DO CASE
  158.  
  159.     *--- Non-critical errors
  160.     CASE sterrnum $ ' 1 50 54 124 125 1105 1112 ' .OR. (errnum > 1240 .AND. errnum < 1247)
  161.         DO alert WITH errmes 
  162.         RETURN
  163.  
  164.     *--- EOF error
  165.     CASE errnum = 4
  166. <<forall databases>>
  167.         IF RECCOUNT({dbfcount}) = 0 
  168.             answer = 1 
  169.             DO alert2 WITH answer,DBF({dbfcount})+ msg_addrec
  170.             IF answer = 1
  171.         <<if ismultials>>
  172.                 SELECT {dbfcount}
  173.         <<endif>>
  174.                 APPEND BLANK
  175.         <<if ismultials>>
  176.                 SELECT &temparea
  177.         <<endif>>
  178.                 RETRY
  179.            ELSE
  180.                 DO alert WITH msg_fatal 
  181.                 mexit = .T.
  182.                 DO closedown
  183.                 CANCEL
  184.            ENDIF
  185.         ENDIF
  186.     <<forall relations>>
  187.         IF EOF({"}{relals}{"})
  188.             answer = 1
  189.             DO alert2 WITH answer, 'No matching record in '+DBF({"}{relals}{"})+' add ?' 
  190.             IF answer = 1
  191.                 SELECT {relals}
  192.                 APPEND BLANK
  193.                 SELECT &temparea
  194.                 RETRY
  195.             ENDIF
  196.             CLEAR GETS
  197.             DEACTIVATE MENU
  198.         ENDIF
  199.     <<endfor>>
  200. <<endfor>>
  201.         DEACTIVATE MENU
  202.  
  203.     *--- Critical errors causing program termination
  204.  
  205.     OTHERWISE
  206.         
  207.         DO alert WITH msg_fatal 
  208.         
  209.         * --- Restore initial environment
  210.         DO closedown
  211.         CANCEL
  212. ENDCASE
  213.  
  214. * --- Procedure called when the Esc key is pressed; you are given the option
  215. * --- to quit this program
  216.  
  217. PROCEDURE doescape
  218. answer = 1
  219. DO alert2 WITH answer, msg_stop 
  220. IF answer = 1
  221.    DO closedown
  222.    CANCEL
  223. ENDIF
  224. ACTIVATE SCREEN
  225. RETURN
  226.  
  227. * --- restore environment settings before quitting
  228.  
  229. PROCEDURE closedown
  230. ON ESCAPE
  231. ON ERROR
  232. CLOSE ALL
  233. SET HELP TO
  234. SET COLOR TO
  235. CLEAR
  236. CLEAR WINDOWS
  237. SET PROCEDURE TO
  238. SET SAFETY &menv_safe
  239. SET BELL &menv_bell
  240. SET HELP &menv_help
  241. SET STATUS &menv_stat
  242. SET FULLPATH &menv_full
  243. SET ESCAPE &menv_esca
  244. SET DELETED &menv_dele
  245. SET CLOCK &menv_cloc
  246. SET ECHO &menv_echo
  247. SET TALK &menv_talk
  248. SET DEBUG &menv_debu
  249. SET COLOR OF SCHEME 2 TO
  250. RETURN
  251.  
  252. * --- Removes all non-alpha characters from a string replacing them 
  253. * --- with a space
  254.  
  255. FUNCTION alphaonly
  256. PARAMETER msource
  257. mlen = LEN(msource)
  258. mtarget = ''
  259. FOR ms = 1 TO mlen
  260.     mtarget = mtarget + IIF(ISALPHA(SUBSTR(msource,ms,1)),SUBSTR(msource,ms,1),' ')
  261. ENDFOR
  262. RETURN mtarget
  263.  
  264. * --- This procedure builds the online Help file if one is not present
  265.  
  266. PROCEDURE domemo
  267. PRIVATE mftemp
  268. mftemp = SYS(3)+'.DBF'
  269. COPY TO &mftemp STRUCTURE EXTENDED
  270. USE (mftemp) EXCLUSIVE
  271. ZAP
  272. APPEND BLANK
  273. REPLACE field_name WITH 'TOPIC',field_type WITH 'Character',field_len WITH 30
  274. APPEND BLANK
  275. REPLACE field_name WITH 'DETAILS',field_type WITH 'Memo',field_len WITH 10
  276. USE
  277. CREATE {fileprefix}_help.dbf FROM &mftemp
  278. DELETE FILE (mftemp)
  279. USE {fileprefix}_help
  280. mhelpno = 23
  281. DIMENSION hlp_text[mhelpno,2]
  282. hlp_text[1,1] = '   <<< FILE MENU >>> '
  283. hlp_text[1,2] = 'The File menu contains Help, Database, and Quit options.  For more information on these options, choose the appropriate topic in this Help facility.'
  284. hlp_text[2,1] = ' - Help'
  285. hlp_text[2,2] = 'Choosing Help displays the Help window with a list of available help topics.  Choose a topic to see more information on that topic.'
  286. hlp_text[3,1] = ' - Database'
  287. hlp_text[3,2] = 'This option is enabled when you have more than one database open.  When you choose the Database... option a list of open databases is displayed.  Select the database you wish to make active.'
  288. hlp_text[4,1] = ' - Quit '
  289. hlp_text[4,2] = 'Exit this program. '
  290. hlp_text[5,1] = '   <<< GO MENU >>>'
  291. hlp_text[5,2] = 'The Go menu contains Seek, Goto, Locate, Continue, Next, Prior, Top and Bottom options.  For more information on one of these options, choose the appropriate topic in this Help facility.'
  292. hlp_text[6,1] = ' - Seek'
  293. hlp_text[6,2] = 'Seek is enabled when an index is active.  This option searches the database for a record that matches the expression you create.'
  294. hlp_text[7,1] = ' - Goto'
  295. hlp_text[7,2] = 'When you choose Goto..., a dialog appears so you can move the record pointer to the top or bottom of the active database or to a specific record number.'
  296. hlp_text[8,1] = ' - Locate'
  297. hlp_text[8,2] = 'The database will be searched for a record that matches the expression you create in the expression builder.  The expression must be logical, and the database need not be indexed.'
  298. hlp_text[9,1] = ' - Continue'
  299. hlp_text[9,2] = 'If a Locate is successful, the Continue option will be available.  You may then search for the next record that matches the expression you created with the Locate option.'
  300. hlp_text[10,1] = ' - Next'
  301. hlp_text[10,2] = 'Choose this option to move the record pointer to the next record in the database.'
  302. hlp_text[11,1] = ' - Prior'
  303. hlp_text[11,2] = 'Choose this option to move the record pointer to the previous record in the database.'
  304. hlp_text[12,1] = ' - Top'
  305. hlp_text[12,2] = 'Choose this option to move the record pointer to the top of the database.'
  306. hlp_text[13,1] = ' - Bottom'
  307. hlp_text[13,2] = 'Choose this option to move the record pointer to the last record in the database.'
  308. hlp_text[14,1] = '   <<< RECORD MENU >>>'
  309. hlp_text[14,2] = 'The Record menu contains the Edit, Add, Browse and Delete options.  For more information on one of these options, choose the appropriate topic in this Help facility.'
  310. hlp_text[15,1] = ' - Edit'
  311. hlp_text[15,2] = 'Choose this option to edit the current record.'
  312. hlp_text[16,1] = ' - Add'
  313. hlp_text[16,2] = 'This option allows you to add a blank record to the database.'
  314. hlp_text[17,1] = ' - Browse'
  315. hlp_text[17,2] = 'Choosing the Browse option opens a Browse window for the database.  In Browse you may view and edit records, and add and delete records.'
  316. hlp_text[18,1] = ' - Delete Recall'
  317. hlp_text[18,2] = 'You may delete the current record by choosing this option.  When a record is marked for deletion, this option changes to Recall, and the record may then be reactivated.'
  318. hlp_text[19,1] = '   <<< UTILITIES MENU >>>'
  319. hlp_text[19,2] = 'The Utilities menu contains the Report, Label, Pack and Reindex options.  For more information on one of these options, choose the appropriate topic in this Help facility.'
  320. hlp_text[20,1] = ' - Report'
  321. hlp_text[20,2] = 'You may create, modify, or print a report by choosing this option.  A Report layout window is opened where you may set up or modify a report.'
  322. hlp_text[21,1] = ' - Label'
  323. hlp_text[21,2] = 'You may create, modify, or print labels by choosing this option.  A Label layout window is opened where you may set up or modify labels.'
  324. hlp_text[22,1] = ' - Pack'
  325. hlp_text[22,2] = 'Choosing the Pack option removes all records from the current database that are marked for deletion.  You may mark records to be deleted with the Delete option of the Record menu.'
  326. hlp_text[23,1] = ' - Reindex'
  327. hlp_text[23,2] = 'The Reindex option is used to update indexes that were not open when records were added or deleted from a database file.'
  328. * --- build database from array
  329. FOR mx = 1 TO mhelpno
  330.     APPEND BLANK
  331.     REPLACE topic WITH hlp_text[mx,1],;
  332.     details WITH ALLTRIM(ALPHAONLY(PROPER(hlp_text[mx,1])))+CHR(13)+hlp_text[mx,2]
  333. NEXT
  334. RETURN
  335.  
  336. <<end>> <<*GenProcStandard*>>
  337.  
  338. <<* Get index file names *>>
  339.  
  340. <<#
  341. function GetIndexNames( indexchoice : integer ) : string
  342. string ndxnames,fpath,fname,fext
  343. begin
  344.     <<*--Start with selected index--*>>
  345.     select index indexchoice
  346.     filespec(ndxnam,fpath,fname,fext)
  347.     ndxnames := '"'+fname+'.'+fext+'"'
  348.     forall indexes
  349.         if ndxcount <> indexchoice
  350.             filespec(ndxnam,fpath,fname,fext)
  351.             ndxnames := ndxnames+ ',' + '"' + fname + '.' + fext + '"'
  352.         endif
  353.     endfor
  354.     return ndxnames
  355. end GetIndexNames
  356. #>>
  357.  
  358. <<procedure GenSEEK>>
  359. <<begin>>
  360.  
  361. * --- Procedure called when Seek is chosen from the Go menu 
  362.  
  363. PROCEDURE {fileprefix}_seek
  364. PRIVATE seekexpr
  365. IF .NOT. hasindex(dbfarea) 
  366.     DO alert WITH "No Order Set. Can't Seek."
  367.     RETURN
  368. ENDIF
  369. ndxkey = SYS(14,1,dbfarea)
  370. ndxtype = TYPE(ndxkey)
  371. IF ndxtype <> 'U'
  372.     GETEXPR "Value to SEEK <expc> (index = " +ndxkey + ")" TO seekexpr TYPE ndxtype
  373.     IF '' <> TRIM(seekexpr) 
  374.         mrecno = RECNO() 
  375.         SEEK &seekexpr
  376.         IF EOF()
  377.             DO alert WITH msg_nofind
  378.             GOTO mrecno
  379.         ENDIF
  380.     ENDIF
  381. ELSE
  382.     DO alert WITH msg_illkey
  383. ENDIF
  384. RETURN
  385. <<end>> <<*GenSEEK*>>
  386.  
  387. <<#
  388.  
  389. <<* Check for index present *>>
  390.  
  391. procedure GenProcSecond
  392. begin
  393.     select all
  394.     if ndxtotal > 0 <<*Total ndxs for entire system*>>
  395.         GenSEEK
  396.     endif
  397. end>> <<*genProcSecond*>>
  398. #>>
  399.  
  400.     
  401.