home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMSPROC.PRG < prev    next >
Text File  |  1992-04-29  |  5KB  |  150 lines
  1. *----------------------------------------------------------------------------
  2. *
  3. *   Program Name: MEMSPROC.PRG      Copyright: EDON Corporation                                         
  4. *   Date Created: 02/24/91           Language: Clipper S'87                                             
  5. *   Time Created: 11:08:43             Author: Ed Phillips                               
  6. *    Description: Write Source Code for a Screen Procedure.
  7. *----------------------------------------------------------------------------
  8.  
  9. PROCEDURE MakScrnCode
  10.    PRIVATE fname, pname, l, workbuff, oldcolor, gname, prom1, prom2, prom3
  11.  
  12.    SET DELETED ON
  13.    oldcolor = Setcolor(c_statln1)
  14.    fname = Space(20)
  15.    sname = Space(4)
  16.    gname = Space(4)
  17.  
  18.    IF Eof()
  19.       Sayerr('Screen.dbf is empty')
  20.       RETURN
  21.    ENDIF                                         && IF Eof()
  22.  
  23.    SELECT ScrnGets
  24.    SEEK Scr_file->Scrn_name
  25.  
  26.    SELECT Scr_file 
  27.  
  28.    prom1 = ' Enter Name of File to Create:'
  29.    prom2 = ' Enter Name of Screen Procedure to Create:'
  30.    prom3 = ' Enter Name of Get Procedure to Create:   '   
  31.    l = Centr(prom1,20)
  32.  
  33.    Shadow(2,l-1,6,l+51)
  34.    Scroll(2,l-1,6,l+51,0)
  35.    @ 2,l-1 TO 6, l+51
  36.    @ 2,l+16 SAY " Write Clipper S'87 Code "
  37.  
  38.    @ 03,l SAY prom1 GET fname
  39.    @ 04,l SAY prom2 GET sname
  40.    IF ! ScrnGets->(Eof())
  41.       @ 05,l SAY prom3 GET gname
  42.    ENDIF                                         && IF ! ScrnGets->(Eof())
  43.  
  44.    READ
  45.  
  46.    IF ! Empty(fname)
  47.       l = 0
  48.       @ 07,20 SAY ' WORKING.... '
  49.  
  50.       SET PRINTER TO (fname)
  51.       SET DEVICE TO PRINT
  52.  
  53.       @ Prow(),0 SAY '* Program: '+fname
  54.  
  55.       *-------------------------
  56.       * Write the SCREEN Routine
  57.       *-------------------------
  58.       IF ! Empty(sname)
  59.          l = 3
  60.          @ Prow()+2,0 SAY 'PROCEDURE '+Trim(sname)+'_scrn'
  61.       ENDIF
  62.  
  63.       @ Prow()+1,l SAY 'Setcolor(c_field)'
  64.       @ Prow()+1,l SAY 'Scroll('+Strzero(St,2,0)+','+Strzero(Sl,2,0)+','+;
  65.         Strzero(Sb,2,0)+','+Strzero(Sr,2,0)+',0)'
  66.  
  67.       @ Prow()+2,l+12 SAY '*          1         2         3         4         5         6         7'
  68.       @ Prow()+1,l+12 SAY '*01234567890123456789012345678901234567890123456789012345678901234567890123456789'
  69.       @ Prow()+1,l SAY ''
  70.  
  71.       width = Sr - Sl + 1
  72.  
  73.       num_ln = Sb - St + 1
  74.       k = 1
  75.       FOR i = 1 TO num_ln
  76.          pline = ' '
  77.          FOR j = 1 TO width
  78.             pline = pline + Subs(Screen,k,1)
  79.             k = k + 2
  80.          NEXT                                    && FOR j = 1 TO char_cnt
  81.          IF ! Empty(pline)
  82.             @ Prow()+1,l SAY [@ ]+Strzero(St+i-1,2,0)+[,]+Strzero(Sl,2,0)+[ SAY "] + Subs(Trim(pline),2) + ["]
  83.          ENDIF                                   && IF ! Empty(pline)
  84.       NEXT                                       && FOR i = 1 TO num_ln
  85.       @ Prow()+1,0 SAY "RETURN"
  86.  
  87.       *----------------------
  88.       * Write the GET routine
  89.       *----------------------
  90.       IF ! Empty(gname)
  91.          SELECT ScrnGets
  92.          rec = Recno()
  93.  
  94.          @ Prow()+2,0 SAY 'PROCEDURE '+Trim(gname)+'_get'
  95.          @ Prow()+1,l SAY 'PARAMETERS mode'
  96.  
  97.          @ Prow()+2,l SAY 'Setcolor(c_field)'
  98.  
  99.          DO WHILE Scrn_name == Scr_file->Scrn_name .AND. ! Eof()
  100.             @ Prow()+1,l SAY '@ '+Strzero(G_row,2,0)+','+Strzero(G_col,2,0)+' GET '+Trim(G_var)
  101.             IF ! Empty(G_pic)
  102.                @ Prow(),Pcol() SAY ' PICT "'+Trim(G_pic)+'"'
  103.             ENDIF
  104.             SKIP
  105.          ENDDO                                   && DO WHILE ! Eof()
  106.          GO rec
  107.  
  108.          @ Prow()+1,l SAY 'READ'
  109.          @ Prow()+2,l SAY 'IF Lastkey() != 27'
  110.          @ Prow()+1,l SAY "   IF mode = 'ADD'"
  111.          @ Prow()+1,l SAY '      APPEND BLANK'
  112.          @ Prow()+1,l SAY '   ENDIF'
  113.          @ Prow()+2,l SAY "   Automem('REPL')"
  114.          @ Prow()+1,l SAY 'ENDIF'
  115.          @ Prow()+1,0 SAY 'RETURN'
  116.  
  117.          *--------------
  118.          * SAY procedure
  119.          *--------------
  120.          @ Prow()+2,0 SAY 'PROCEDURE '+Trim(gname)+'_say'
  121.  
  122.          @ Prow()+1,l SAY 'DO '+Trim(sname)+'_scrn'
  123.          @ Prow()+1,0 SAY ''
  124.          DO WHILE Scrn_name == Scr_file->Scrn_name .AND. ! Eof()
  125.             @ Prow()+1,l SAY '@ '+Strzero(G_row,2,0)+','+Strzero(G_col,2,0)+' SAY '+Trim(G_var)
  126.             IF ! Empty(G_pic)
  127.                IF (',' $ G_pic) .OR. ('@R' $ G_pic) .OR. ('Y' $ G_pic)
  128.                   @ Prow(),Pcol() SAY ' PICT "'+Trim(G_pic)+'"'
  129.                ENDIF
  130.             ENDIF
  131.             SKIP
  132.          ENDDO                                   && DO WHILE ! Eof()
  133.          GO rec
  134.  
  135.          @ Prow()+1,0 SAY 'RETURN'
  136.  
  137.       ENDIF                                         && IF ! Empty(gname)
  138.  
  139.       @ Prow()+1,0 SAY "* EOF: "+fname
  140.       SET DEVICE TO SCREEN
  141.       SET PRINTER TO
  142.    ENDIF                                         && IF ! Empty(fname)
  143.  
  144.    Setcolor(oldcolor)
  145.    Restscreen(1,0,24,79,buffer1)
  146.    SET DELETED OFF
  147. RETURN
  148.  
  149. * EOF: Memsproc.prg
  150.