home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSAB.GEN < prev    next >
Encoding:
Text File  |  1988-06-03  |  4.1 KB  |  156 lines

  1. <<#pragma
  2.  
  3. <<*---Declare global variables---*>>
  4. string  fpath,fname,fext
  5. string  prgpath,prgname,fileprefix,datafile,pathfileprefix
  6. logical Simple,Bracketed,LiteBar
  7. logical Fox
  8. logical ismultipage,ismultials,ismultindx
  9. integer menutype
  10.  
  11. <<*---OPEN vars---*>>
  12. integer SCREENWIDTH
  13.  
  14. <<*---GENVARS vars---*>>
  15. string  fldprefix
  16.  
  17. <<*---FEATURE vars---*>>
  18. integer features
  19. integer featals,featlabel
  20.  
  21.  
  22. function feat( num : integer ) : logical
  23. <<*16-bit feature combinations (1...16)*>>
  24. <<*bits: 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32768*>>
  25. begin
  26.   RETURN (features and num) <> 0
  27. end feat
  28.  
  29. #>>
  30. <<*---General modules---*>>
  31. <<#include 'GENSAY.INC'#>>   <<*To generate @row,col SAY,etc.*>>
  32. <<#include 'GENSTR.INC'#>>   <<*General string functions*>>
  33. <<#include 'GENVARS.INC'#>>  <<*Contains fixfldnam,GenMemVars,etc.*>>
  34. <<#include 'GENFILE.INC'#>>  <<*Contains GenHeader,GenFooter,etc.*>>
  35. <<#include 'GENCOLOR.INC'#>> <<*Contains GenColor,etc.*>>
  36. <<*---Application---*>>
  37. <<#include 'msaFILE.INC'#>>  <<*General routines used by others*>>
  38. <<#include 'msaPRIV.INC'#>>  <<*Special routines for APPE/EDIT*>>
  39. <<#include 'msaMAIN.INC'#>>
  40. <<#include 'msaLOGO.INC'#>>
  41. <<#include 'msaOPEN.INC'#>>
  42. <<#include 'msaEDONE.INC'#>>
  43. <<#include 'msaEDIT.INC'#>>
  44. <<#include 'msaAPPE.INC'#>>
  45. <<#include 'msaLAB1.INC'#>>
  46. <<#include 'REPUTIL.INC'#>>
  47. <<#include 'msaRPT1.INC'#>>
  48. <<#include 'msaQUIT.INC'#>>
  49. <<#pragma
  50.  
  51.  
  52. procedure GenMainPrg
  53. begin
  54.   <<* 'prgname' includes PATHNAME *>>
  55.   if OpenFile( prgname,'MAIN program for ' + datafile + '.DBF' )
  56.     GenMainBody
  57.     GenFooter( prgname )
  58.   end
  59. end <<*GenMainPrg*>>
  60.  
  61.  
  62. procedure GenPrograms
  63. string  fspec,filename
  64. begin
  65.   filename := datafile + '.DBF'
  66.   fspec := pathfileprefix + '_QUIT.PRG'
  67.   if OpenFile( fspec,'QUIT program for ' + filename )
  68.     GenQuit
  69.     GenFooter( fspec )
  70.   end
  71.   filename := datafile + '.DBF'
  72.   fspec := pathfileprefix + '_LOGO.PRG'
  73.   if OpenFile( fspec,'LOGO program for ' + filename )
  74.     GenLogo
  75.     GenFooter( fspec )
  76.   end
  77.   fspec := pathfileprefix + '_OPEN.PRG'
  78.   if OpenFile( fspec,'OPEN program for ' + filename )
  79.     GenOpenBody
  80.     GenFooter( fspec )
  81.   end
  82.   fspec := pathfileprefix + '_EDIT.PRG'
  83.   if OpenFile( fspec,'EDIT program for ' + filename )
  84.     GenEditBody
  85.     GenFooter( fspec )
  86.   end
  87.   fspec := pathfileprefix + '_APPE.PRG'
  88.   if OpenFile( fspec,'APPEND program for ' + filename )
  89.     GenAppendBody
  90.     GenFooter( fspec )
  91.   end
  92.   select all
  93.   select database 1
  94.   if feat(featlabel)
  95.     fspec := pathfileprefix + '_1LAB.PRG'
  96.     if OpenFile( fspec,'Print ONE LABEL program for ' + filename )
  97.       GenOneLabel
  98.       GenFooter( fspec )
  99.     endif
  100.     fspec := pathfileprefix + '_1RPT.PRG'
  101.     if OpenFile( fspec,'Print SINGLE RECORD program for ' + filename )
  102.       GenOneReport
  103.       GenFooter( fspec )
  104.     endif
  105.   endif
  106. end <<*GenPrograms*>>
  107.  
  108.  
  109. procedure InitVariables
  110. begin
  111.   SCREENWIDTH := 0
  112.   fldprefix := 'm'   <<*FIELD_NAME prefix when using memvars*>>
  113.   <<*---Init Product logical vars---*>>
  114.   Fox     := (ProductCode = 1)
  115.   select all
  116.   ismultipage := (pagtotal > 1)
  117.   ismultials := (dbftotal > 1)
  118.   ismultindx := false
  119.   forall databases
  120.     if ndxtotal > 1
  121.       ismultindx := true
  122.     endif
  123.   endfor
  124.   <<*---Select Menu Type---*>>
  125.   Bracketed := (menutype = 0)  <<*Default, if they press ESC*>>
  126.   Simple    := (menutype = 1)
  127.   Bracketed := (menutype = 2)
  128.   LiteBar   := (menutype = 3)
  129.   featlabel := 2
  130.   pathfileprefix := prgpath + fileprefix
  131. end <<*InitVariables*>>
  132.  
  133.  
  134. procedure InitFromStack
  135. begin
  136.   <<*---Restore stack variables in REVERSE order---*>>
  137.   pop( prgpath )       <<*Pathname of main program to generate*>>
  138.   pop( prgname )       <<*Filename of main program to generate*>>
  139.   pop( fileprefix )    <<*Three letter file prefix*>>
  140.   pop( datafile )      <<*filename of PRIMARY database file*>>
  141.   pop( menutype )      <<*Menu/Submenu prompt type*>>
  142.   pop( features )      <<*feature combinations*>>
  143. end <<*InitFromStack*>>
  144.  
  145.  
  146. begin <<*MAIN*>>
  147.   InitFromStack
  148.   InitVariables
  149.   select all
  150.   GenMainPrg
  151.   GenPrograms
  152. end
  153.  
  154. <<*EOF: MSAB.GEN*>>
  155. #>>
  156.