home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a046 / 5.img / TEMPLATE / SSBPRIV.INC < prev    next >
Encoding:
Text File  |  1992-04-01  |  3.0 KB  |  134 lines
  1. <<* SSBPRIV.INC *>>
  2. <<* (C) 1991 SHEN YANG WHITE HORSE SOFTWART COMPANY  *>>
  3.  
  4. <<#
  5. procedure GenMemStore( stotyp,stostr : string )
  6. begin
  7.   select all fields
  8.   select fields on (fldtyp = stotyp) and (fldals = 'M') and fldget
  9.   if fldtotal > 0
  10.     GenFldList( stostr )
  11.   endif
  12. end GenMemStore
  13.  
  14.  
  15. procedure GenFldStore( stotyp,stostr : string )
  16. begin
  17.   select all fields
  18.   select fields on (fldtyp = stotyp) and (fldals <> 'M') and fldget
  19.   if fldtotal > 0
  20.     GenFldList( stostr )
  21.   endif
  22. end GenFldStore
  23.  
  24.  
  25. procedure GenPrivateFlds( switch : integer )
  26. begin
  27.   select all
  28.   select fields on (fldtyp $ 'CDLN') and (fldals <> 'M') and fldget
  29.   if (fldtotal > 128)
  30.     genln( '* ---Declare field memory variables.' )
  31.     genln( 'DO CASE' )
  32.     forall databases
  33.       filespec( dbfnam,fpath,fname,fext )
  34.       genln( 'CASE dbfarea = "',dbfcount,'"' )
  35.       pushmargin( 1 )
  36.       genln( '* ---Using ',fname,'.',fext )
  37.       if fldtotal > 0
  38.         if switch = 0
  39.           GenFldList( 'PRIVATE;' )
  40.           GenFldStore( 'C','STORE " " TO;' )
  41.           GenFldStore( 'N','STORE 0.00 TO;' )
  42.           GenFldStore( 'L','STORE .F. TO;' )
  43.           GenFldStore( 'D','STORE CTOD("  /  /  ") TO;' )
  44.         else
  45.           GenFldList( 'RELEASE;' )
  46.         endif
  47.       else
  48.         genln( '* ---<No fields>.' )
  49.       endif
  50.       popmargin
  51.     endfor
  52.     genln( 'ENDCASE' )
  53.   endif
  54. end GenPrivateFlds
  55. #>>
  56.  
  57.  
  58. <<procedure GenOutputItems>>  <<*Used in APPE/EDIT prgs*>>
  59. <<begin>>
  60. DO SayLine WITH row,"PRINT:  {L}abel  {R}ecord  <Return> "
  61. DO GetKey WITH choice,"LR"+Returnkey
  62. DO CASE
  63. CASE choice = "L"
  64.    DO {fileprefix}0.LAB WITH row
  65. CASE choice = "R"
  66.    DO {fileprefix}0.RPT WITH row
  67. ENDCASE
  68. <<end GenOutputItems>>
  69.  
  70.  
  71. <<#
  72. procedure GenPageMenu
  73. <<*       1         2         3         4         5
  74. 01234567890123456789012345678901234567890123456789012345
  75. PAGE:   Forward  ({line})  <Return>
  76. *>>
  77. string line
  78. integer col
  79. begin
  80.   forall pages
  81.     if forcount <= 16
  82.       line := line + ' ' + str(pagcount) + ' '
  83.     endif
  84.   endfor
  85. #>>
  86. pagechoice = pageno + 1
  87. <<GenColor( 0,'PROMPT' )>>
  88. @ row, 0 CLEAR
  89. @ row, 0 SAY {"}PAGE:   Forward  ({line})  <Return>{"}
  90. @ row, 8 PROMPT "Forward"
  91. <<#
  92.   col := 18
  93.   forall pages
  94.     if forcount <= 16
  95.       genln( '@ row,',col,' PROMPT " ',pagcount,' "' )
  96.       col := col + 3
  97.     endif
  98.   endfor
  99.   col := col + 3
  100. #>>
  101. @ row,{col} SAY "<Return>"
  102.   <<col := col + 1>>
  103. @ row,{col} PROMPT "Return"
  104. MENU TO pagechoice
  105. <<#
  106.   line := ''
  107.   forall pages
  108.     if pagcount <= 16
  109.       line := line + 'S'
  110.     endif
  111.   endfor
  112. #>>
  113. choice = SUBSTR( Returnkey+PgDn+{"}{line}{"}+Returnkey,pagechoice+1,1 )
  114. <<end GenPageMenu>>
  115.  
  116.  
  117. <<procedure GenPageItems>>  <<*Used in APPE/EDIT prgs*>>
  118. <<begin>>
  119.   <<GenPageMenu>>
  120. lastpage = pageno
  121. DO CASE
  122. CASE choice = PgDn
  123.    DO Page WITH pageno,1,PageMax
  124. CASE choice = "S"
  125.    pageno = pagechoice - 1
  126. ENDCASE
  127. IF pageno <> lastpage
  128.    DO {fileprefix}0.FOR
  129.    DO SayRec
  130. ENDIF
  131. <<end GenPageItems>>
  132.  
  133. <<* EOF: SSBPRIV.INC *>>
  134.