home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMIMP.PRG < prev    next >
Text File  |  1991-12-17  |  6KB  |  186 lines
  1. *----------------------------------------------------------------------------
  2. *
  3. *   Program Name: MEMIMP.PRG        Copyright: EDON Corporation
  4. *   Date Created: 03/06/91           Language: Clipper S'87
  5. *   Time Created: 21:25:27             Author: Ed Phillips
  6. *    Description: File Import function
  7. *----------------------------------------------------------------------------
  8.  
  9. PRIVATE pcount, oldcolor, inrec
  10. pcount = 4
  11. PRIVATE prompts[pcount],msgs[pcount]             && DEFINE PRIVATE VARIABLES
  12.  
  13. *---------------------------------
  14. * Build array to hold menu choices
  15. *---------------------------------
  16.  
  17. prompts[1] = '1. Text File       '
  18. prompts[2] = '2. Screen Data Base'
  19. prompts[3] = '3. MEM File        '
  20. prompts[4] = '0. Quit            '
  21.  
  22. msgs[1] = 'Import from DOS text file, with or without screen attributes'
  23. msgs[2] = 'Import Screen and Gets from another EDON Screen Data Base'
  24. msgs[3] = "Import from a Clipper S'87 MEM file"
  25. msgs[4] = 'Return to session'
  26.  
  27. item = 1
  28. redraw = .T.
  29. oldcolor = Setcolor(c_default)
  30. CLEAR
  31.  
  32. *-------------
  33. * Display menu
  34. *-------------
  35. DO Bmenu WITH item, redraw, 5, 39, pcount, "Import Menu", prompts, msgs
  36.  
  37. DO CASE
  38.    CASE item = 1                                 && text file
  39.       inrec = Recno()
  40.       fname = Space(20)
  41.       Setcolor(c_field)
  42.       attribs = .f.
  43.       Shadow(3,17,8,63)
  44.       Scroll(3,17,8,63,0)
  45.       @ 3,17 TO 8,63
  46.       @ 3,31 SAY ' Text File Import '
  47.       @ 5,19 SAY 'Enter Text File Name:' GET fname PICT '@K!'
  48.       @ 6,19 SAY 'Does Text File Include Screen Attributes?' GET attribs PICT 'Y'
  49.       READ
  50.       IF ! Empty(fname)
  51.          fname = Trim(fname)
  52.          fname= If('.' $ fname, fname, fname + '.txt')
  53.          IF File(fname)
  54. *            changed = .t.
  55.  
  56.             DO DrawScreen WITH attribs
  57.             buffer1 = Savescreen(1,0,24,79)
  58.             GO BOTTOM
  59.             SKIP
  60.             DO SaveScrn WITH M->st,M->sl,M->sb,M->sr,buffer1
  61.          ELSE
  62.             Sayerr('File &fname. not found')
  63.             Restscreen(1,0,24,79,buffer1)
  64.             GO inrec
  65.          ENDIF
  66.       ELSE
  67.          Restscreen(1,0,24,79,buffer1)
  68.          GO inrec
  69.       ENDIF
  70.  
  71.    CASE item = 2                                 && another screen dbf
  72.       fname = Space(20)
  73.       getname = Space(20)
  74.       Setcolor(c_field)
  75.       Shadow(3,17,8,63)
  76.       Scroll(3,17,8,63,0)
  77.       @ 3,17 TO 8,63
  78.       @ 3,31 SAY ' Screen DBF Import '
  79.       @ 5,19 SAY 'Enter DBF  File Name:' GET fname PICT '@K!'
  80.       @ 6,19 SAY 'Enter GET File Name:' GET getname PICT '@K!'
  81.       READ
  82.       IF ! Empty(fname) .AND. !('SCREEN.DBF' $ fname)
  83.          fname = Trim(fname)
  84.          fname= If('.' $ fname, fname, fname + '.dbf')
  85.          getname = Trim(getname)
  86.          getname= If('.' $ getname, getname, getname + '.dbf')
  87.          IF File(fname)
  88.             fname = Subs(fname,1,At('.',fname)-1)
  89.             getname = Subs(getname,1,At('.',getname)-1)
  90.             SELECT 0
  91.             USE (getname) INDEX (getname) ALIAS Work1
  92.  
  93.             SELECT 0
  94.             USE (fname) INDEX (fname) ALIAS Work
  95.  
  96.             SELECT Scr_file
  97.             srec = Recno()
  98.             SELECT Scrngets
  99.             grec = Recno()
  100.  
  101.             SELECT Work
  102.             DO WHILE .T.
  103.                DO Memfind
  104.                SELECT Work
  105.                IF Lastkey() = esc
  106.                   EXIT
  107.                ELSE
  108.  
  109.                   *------------------------------
  110.                   * Import selected Screen record
  111.                   *------------------------------
  112.                   Automem('STUP')
  113.                   SELECT Scr_file
  114.                   SEEK M->scrn_name
  115.                   IF ! Found()
  116.                      APPEND BLANK
  117. *                     changed = .t.
  118.                      Automem('REPL')
  119.  
  120.                      *--------------------
  121.                      * Import the GETS too
  122.                      *--------------------
  123.                      SELECT Work1
  124.                      SEEK Work->Scrn_name
  125.                      DO WHILE Scrn_name == Work->Scrn_name .AND. ! Eof()
  126.                         Automem('STUP')
  127.                         SELECT Scrngets
  128.                         APPEND BLANK
  129.                         Automem('REPL')
  130.                         SELECT Work1
  131.                         SKIP
  132.                      ENDDO                       && DO WHILE Scrn_name == Work->Scrn_name .AND. ! Eof()
  133.  
  134.                   ELSE
  135.                      Sayerr('Selected Screen Name Already Exists in Target File')
  136.                   ENDIF                          && IF ! Found()
  137.  
  138.                   SELECT Work
  139.                ENDIF                             && IF Lastkey = esc
  140.             ENDDO                                && DO WHILE .T.
  141.             SELECT Work
  142.             USE
  143.             SELECT Work1
  144.             USE
  145.             SELECT Scrngets
  146.             GO grec
  147.             SELECT Scr_file
  148.             GO srec
  149.             Restscreen(St,Sl,Sb,Sr,Screen)
  150.          ENDIF                                   && IF File(fname)
  151.       ELSE
  152.          Restscreen(1,0,24,79,buffer1)
  153.       ENDIF                                      && IF ! Empty(fname)
  154.  
  155.    CASE item = 3                                 && a MEM file
  156.       fname = Space(20)
  157.       varname = Space(10)
  158.       Setcolor(c_field)
  159.       Shadow(3,17,8,63)
  160.       Scroll(3,17,8,63,0)
  161.       @ 3,17 TO 8,63
  162.       @ 3,31 SAY ' MEM  File Import '
  163.       @ 5,19 SAY 'Enter MEM  File Name:' GET fname PICT '@K!'
  164.       @ 6,19 SAY 'Enter MemVar Name:' GET varname PICT '@!'
  165.       READ
  166.       IF ! Empty(fname)
  167.          fname = Trim(fname)
  168.          fname= If('.' $ fname, fname, fname + '.mem')
  169.          IF File(fname)
  170.             RESTORE FROM (fname) ADDITIVE
  171.             IF ! Empty(varname)
  172.                changed = .t.
  173.                RestScreen(1,0,24,79,&varname.)
  174.             ENDIF                                && IF ! Empty(varname)
  175.          ENDIF                                   && IF File(fname)
  176.       ELSE
  177.          Restscreen(1,0,24,79,buffer1)
  178.       ENDIF                                      && IF ! Empty(fname)
  179.    OTHERWISE
  180.       Restscreen(1,0,24,79,buffer1)
  181. ENDCASE
  182.  
  183. Setcolor(oldcolor)
  184. RETURN                                           && RETURN TO CALLING PROGRAM
  185. * EOF: MEMIMP.PRG
  186.