home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / TEMPLGEN / PROMAIN.INC < prev    next >
Encoding:
Text File  |  1990-02-20  |  9.4 KB  |  338 lines
  1. <<* Promain.inc *>>
  2.  
  3. <<procedure GenMainBody>>
  4. <<string mflash>>
  5. <<begin>>
  6.  
  7. CLOSE ALL
  8. CLEAR ALL
  9. CLEAR   
  10.  
  11. *--- Save existing FoxPro environment
  12.  
  13. SET CONSOLE OFF
  14. menv_talk = SET('TALK')
  15. menv_stat = SET('STAT')
  16. menv_help = SET('HELP')
  17. menv_bell = SET('BELL')
  18. menv_full = SET('FULL')
  19. menv_safe = SET('SAFE')
  20. menv_esca = SET('ESCA')
  21. menv_dele = SET('DELE')
  22. menv_cloc = SET('CLOC')
  23. menv_echo = SET('ECHO')
  24. menv_debu = SET('DEBUG')
  25. SET CONSOLE ON
  26.  
  27. *--- Establish Program Environment
  28.  
  29. SET TALK OFF
  30. SET STATUS OFF
  31. SET HELP ON
  32. SET BELL ON
  33. SET FULLPATH OFF
  34. SET SAFETY OFF
  35. SET ESCAPE ON
  36. SET DELETE OFF
  37. SET CLOCK TO 0,69
  38. SET CLOCK ON
  39. SET ECHO OFF
  40. SET DEBUG OFF
  41. SET COLOR OF SCHEME 2 TO SCHEME 4
  42. SET REPROCESS TO AUTOMATIC
  43. SET REFRESH TO 10
  44.  
  45. * --- Declare Global memory variables.
  46.  
  47. PUBLIC;
  48.   dbfarea,choice,expr,bye,mdelete,dbname(10),mcount,hasindex(10),tindex
  49.  
  50. <<select all>>
  51.  
  52. * ---Initialize Global memory variables.
  53.  
  54. dbfarea = 1
  55. expr = ''
  56. expr2 = ''
  57. hasindex = .F.
  58. msg_eof = 'This is the last record.'
  59. msg_bof = 'This is the first record.'
  60. msg_loc1 = 'No matching records found.'
  61. msg_loc2 = 'No more matching records found.'
  62. msg_pack = 'NOT UNDOABLE! - Remove all deleted records?'
  63. msg_stop = 'Do you want to stop running this program?'
  64. msg_fatal = 'Cannot continue running program.'
  65. msg_reind = 'Rebuild Index files for current database?'
  66. msg_range = 'Record out of range.'
  67. msg_nofile = 'File does not exist.'
  68. msg_nofind = 'Record not found.'
  69. msg_illkey = 'Illegal Key Expression Type.'
  70. msg_cr_idx = ' not found, create index?'
  71. msg_addrec = ' empty.  Add a record?'
  72. msg_exclu = 'File must be opened exclusively to reindex.'
  73. <<if ndxtotal > 0>>
  74. ndxorder = '1'
  75. <<else>>
  76. ndxorder = ''
  77. <<endif>>
  78. <<if ismultials>>
  79. multidbf = .T.
  80. oldarea = dbfarea
  81. continueon = .F.
  82. <<else>>
  83. multidbf = .F.
  84. <<endif>>
  85. STORE .F. TO bye,noopen,medit,mexit,continueon
  86.  
  87. * --- Activate ON ERROR and ON ESCAPE routines
  88.  
  89. mdelete = ' \<Delete   ' 
  90. DEFINE WINDOW alert FROM 15,15 TO 21,65 DOUBLE SHADOW  COLOR SCHEME 7
  91. ON ERROR DO doerror WITH ERROR(), MESSAGE()
  92. ON ESCAPE DO doescape
  93.  
  94. * ---Set the color environment and define all windows
  95.  
  96. <<defmemo>>
  97. DEFINE WINDOW mbrowse FROM 4,15 to 20,65 PANEL SHADOW CLOSE FLOAT GROW ZOOM COLOR SCHEME 10
  98. << mflash := substr(screencolor,at('/',screencolor)+1,at(',',screencolor)-at('/',screencolor)-1) >>
  99. << mflash := mflash+'*/'+substr(screencolor,1,at('/',screencolor)-1) >>
  100. << mflash := stuff(mflash,at('+',mflash),1,'') >> 
  101. mflash = {'}{mflash}{'}
  102. schm1 = 'GB/W,N/W,N/W,W+/W,W+/W,N/GB,W+/W,W+/W,W+/GB,W+/W'
  103. schm2 = 'GB/W,W+/BR+,W/BR+,,,W+/B,GR+/BR+'
  104. schm3 = ',W+/R,,,,W/N,GR+/R'
  105. tbar =  'GB+/W' 
  106. DEFINE WINDOW menter2 FROM 7,10 to 19,70 DOUBLE SHADOW COLOR SCHEME 5
  107. DEFINE WINDOW menter FROM 8,20 to 18,60 DOUBLE SHADOW NOCLOSE NOFLOAT NOGROW NOZOOM  COLOR SCHEME 7
  108. dbname = '\' 
  109.  
  110. * --- Routine to open database and index files 
  111. * --- If unable to open files, program exits
  112.  
  113. DO {fileprefix}_open
  114. IF noopen
  115.     DO alert WITH msg_fatal 
  116.     DO closedown
  117.     RETURN
  118. ENDIF
  119.  
  120. * --- Open the on-line Help file
  121.  
  122. SET HELP TO {fileprefix}_help
  123.  
  124. * ---Define menu bar and popup menus
  125.  
  126. DEFINE MENU  mbartop1
  127. DEFINE PAD mbar0 OF mbartop1 AT 0,0     PROMPT '\<File'
  128. DEFINE PAD mbar1 OF mbartop1 AT 0,6  PROMPT '\<Position'
  129. DEFINE PAD mbar2 OF mbartop1 AT 0,16 PROMPT '\<Record'
  130. DEFINE PAD mbar3 OF mbartop1 AT 0,24 PROMPT '\<Utilities'
  131. DEFINE PAD mbar4 OF mbartop1 AT 0,35 PROMPT '\<Next'
  132. DEFINE PAD mbar5 OF mbartop1 AT 0,41 PROMPT 'Pr\<ior'
  133. DEFINE POPUP mbar0 FROM 1,0 SHADOW
  134. DEFINE BAR 1 OF mbar0 PROMPT ' \<Help...    '
  135. DEFINE BAR 2 OF mbar0 PROMPT ' \<Database...' SKIP FOR .NOT. multidbf
  136. DEFINE BAR 3 OF mbar0 PROMPT '\-'
  137. DEFINE BAR 4 OF mbar0 PROMPT ' \<Quit       ' 
  138. DEFINE POPUP mbar1 FROM 1,6 SHADOW
  139. DEFINE BAR 1 OF mbar1 PROMPT ' \<Seek      ' SKIP FOR .NOT. tindex 
  140. DEFINE BAR 2 OF mbar1 PROMPT ' \<Goto...   '
  141. DEFINE BAR 3 OF mbar1 PROMPT ' \<Locate    '
  142. DEFINE BAR 4 OF mbar1 PROMPT ' \<Continue  ' SKIP FOR .NOT. continueon
  143. DEFINE POPUP mbar2 FROM 1,16 SHADOW
  144. DEFINE BAR 1 OF mbar2 PROMPT ' \<Edit     ' 
  145. DEFINE BAR 2 OF mbar2 PROMPT ' \<Add      '
  146. DEFINE BAR 3 OF mbar2 PROMPT ' \<Browse   '
  147. DEFINE BAR 4 OF mbar2 PROMPT '\-'
  148. DEFINE BAR 5 OF mbar2 PROMPT mdelete
  149. DEFINE POPUP mbar3 FROM 1,24 SHADOW
  150. DEFINE BAR 1 OF mbar3 PROMPT ' \<Report... ' 
  151. DEFINE BAR 2 OF mbar3 PROMPT ' \<Label...  '
  152. DEFINE BAR 3 OF mbar3 PROMPT ' \<Pack      '
  153. DEFINE BAR 4 OF mbar3 PROMPT ' Re\<index   ' SKIP FOR .NOT. tindex
  154. ON SELECTION PAD mbar0 OF mbartop1 ACTIVATE POPUP mbar0
  155. ON SELECTION PAD mbar1 OF mbartop1 ACTIVATE POPUP mbar1
  156. ON SELECTION PAD mbar2 OF mbartop1 ACTIVATE POPUP mbar2
  157. ON SELECTION PAD mbar3 OF mbartop1 ACTIVATE POPUP mbar3
  158. ON SELECTION PAD mbar4 OF mbartop1 DO {fileprefix}_mnct WITH 4,6
  159. ON SELECTION PAD mbar5 OF mbartop1 DO {fileprefix}_mnct WITH 5,7
  160. ON SELECTION POPUP mbar0 DO {fileprefix}_mnct WITH 0,BAR()
  161. ON SELECTION POPUP mbar1 DO {fileprefix}_mnct WITH 1,BAR()
  162. ON SELECTION POPUP mbar2 DO {fileprefix}_mnct WITH 2,BAR()
  163. ON SELECTION POPUP mbar3 DO {fileprefix}_mnct WITH 3,BAR()
  164. CLEAR
  165.  
  166. * --- Initialize memory variables 
  167.  
  168. <<initmemory>>
  169. optpad = 'mbar0'
  170.  
  171. * --- Main loop that places @...SAY/GETs on the screen and activates menus
  172. * --- Loop is exited when Quit is chosen from the File menu
  173.  
  174. DO WHILE .NOT. mexit
  175.     ACTIVATE SCREEN
  176.     tindex = hasindex(dbfarea)
  177. <<displayformat>>
  178. <<displayrecord>>
  179.     @ 24,1 SAY 'Database: '+dbname(dbfarea)+'        '
  180.  
  181.     * --- If record is marked for deletion, place proper option in Record menu
  182.  
  183.     IF DELETED()
  184.         @ 0,0 SAY ' File  Position  Record  Utilities  Next  Prior     **  Deleted **    '  
  185.         mdelete = ' \<Recall   ' 
  186.     ELSE 
  187.         @ 0,0 SAY ' File  Position  Record  Utilities  Next  Prior                         ' 
  188.         mdelete = ' \<Delete   '
  189.     ENDIF         
  190.     DEFINE BAR 5 OF mbar2 PROMPT mdelete
  191.  
  192.     * --- If edit or append is chosen from Record menu, READ is activated
  193.  
  194.     IF medit
  195.         READ
  196.         medit = .F. 
  197.     ELSE
  198.         CLEAR GETS
  199.     ENDIF        
  200.     ACTIVATE MENU mbartop1 PAD &optpad
  201. ENDDO  
  202.  
  203. * --- End of main loop
  204.  
  205. * --- Restore the original environment
  206.  
  207. DO closedown
  208.  
  209. RETURN
  210.  
  211. * --- End Main
  212.  
  213. * --- The following procedure is called when a menu popup is selected
  214.  
  215. PROCEDURE {fileprefix}_mnct
  216. PARAMETER row,col
  217. optpad = PAD()
  218. mpop = 'mbar'+ LTRIM(STR(row))
  219.  
  220. *---Hide the menu popup
  221.  
  222. IF row <> 4 .and. row <> 5
  223.     HIDE MENU mbartop1 
  224.     HIDE POPUP &mpop
  225. ENDIF
  226. DO CASE
  227.  
  228.     *--- Exit the main loop and exit this program
  229.     CASE row = 0 .AND. col = 4
  230.         mexit = .T.
  231.  
  232.     *---Select a database a file if more than one has been opened
  233.     CASE row = 0 .AND. col = 2
  234.         ACTIVATE WINDOW menter
  235.         mchoice = dbfarea 
  236.         @ 1,5 SAY 'Select: '
  237.         @ 0,15 MENU dbname,mcount,6
  238.  
  239.         * --- Activate the menu containing available databases
  240.  
  241.         READ MENU TO mchoice
  242.         DEACTIVATE WINDOW menter
  243.         IF mchoice <> dbfarea .AND. mchoice <> 0
  244.             tarea = LTRIM(STR(mchoice)) 
  245.             dbfarea = mchoice 
  246.             continueon = .F. 
  247.             expr = '' 
  248.             SELECT &tarea
  249.         ENDIF
  250.  
  251.     *--- Activate the online Help system
  252.     CASE row = 0 .AND. col = 1
  253.         HELP
  254.         DEACTIVATE WINDOW ALL
  255.  
  256.     *--- If database does not have any records, exit this program
  257.     CASE .NOT. (row=2 .AND. col=1) .AND. (RECCOUNT() = 0)
  258.         DO alert WITH msg_fatal 
  259.         mexit = .T. 
  260.  
  261.     *--- Edit the current record
  262.     CASE row=2 .AND. col= 1
  263.         medit = .T. 
  264.  
  265.     *--- Append a blank record and initialize the fields
  266.     CASE row=2 .AND. col=2
  267.         APPEND BLANK
  268.  
  269.         *--- Note: This will be an empty CASE structure if there are no initial values specified 
  270.         DO CASE 
  271.  << forall databases >>
  272.             CASE dbname(dbfarea) $ DBF({'}{fldals}{'})
  273.      << forall fldgets >>
  274.            << if len(rtrim(fldini)) <> 0 >>
  275.                 REPLACE {fldnam} WITH {fldini}
  276.            << endif >>
  277.      << endfor >> 
  278. << endfor >>
  279.         ENDCASE
  280.         medit = .T. 
  281.  
  282.     *--- Process selection from the Go menu
  283.     CASE row=1 .or. row=4 .or. row=5
  284.         DO {fileprefix}_edit WITH col
  285.  
  286.     *--- Open a browse window
  287.     CASE row=2 .AND. col=3
  288.         IF FILE({'}{fmtname}')
  289.            SET FORMAT TO {fmtname}
  290.            BROWSE WINDOW mbrowse FORMAT 
  291.            SET FORMAT TO
  292.         ELSE
  293.            BROWSE WINDOW mbrowse LAST 
  294.         ENDIF
  295.         DEACTIVATE WINDOW ALL
  296.  
  297.     *--- Mark a record for deletion or unmark a record marked for deletion
  298.     CASE row=2 .AND. col=5
  299.         IF DELETED()
  300.             RECALL NEXT 1
  301.         ELSE
  302.             DELETE NEXT 1
  303.         ENDIF         
  304.  
  305.     *--- Call a routine for processing reports
  306.     CASE row=3 .AND. col=1
  307.         DO {fileprefix}_repo
  308.  
  309.     *--- Call a routine for processing labels
  310.     CASE row=3 .AND. col=2
  311.         DO {fileprefix}_labe
  312.  
  313.     *--- Remove records marked for deletion from the database
  314.     CASE row=3 .AND. col=3
  315.         choice = 1 
  316.         DO alert2 WITH choice,msg_pack 
  317.         IF choice = 1
  318.             PACK
  319.         ENDIF
  320.  
  321.     *--- Update indexes
  322.     CASE row=3 .AND. col=4
  323.         choice = 1 
  324.         IF SET("EXCLUSIVE") = "OFF"
  325.             DO alert WITH msg_exclu
  326.            ELSE     
  327.             DO alert2 WITH choice,msg_reind
  328.             IF choice = 1
  329.                 REINDEX
  330.             ENDIF
  331.         ENDIF
  332. ENDCASE
  333. DEACTIVATE MENU
  334. RETURN
  335.  
  336. <<end>> <<*GenMainBody*>>
  337.  
  338. * --- End of procedure