home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMSCRN.PRG < prev    next >
Text File  |  1992-11-12  |  16KB  |  528 lines
  1. *.............................................................................
  2. *
  3. *   Program Name: MEMSCRN.PRG       Copyright: EDON Corporation
  4. *   Date Created: 02/22/91           Language: Clipper S'87 S'87
  5. *   Time Created: 10:57:25             Author: Ed Phillips
  6. *    Description: Read TXT file that contains screen, set screen colors, 
  7. *                 save screen to memvar, save screen to MEM file
  8. *.............................................................................
  9.  
  10. PARAMETERS par1
  11.  
  12. SET CURSOR ON
  13.  
  14. * Requires a DBF with the following structure:
  15. *     Scrn_num    N     3
  16. *     Scrn_name   C    10
  17. *     Screen      C  4000
  18.  
  19. c_statln1 = 'N/W,W+/G'
  20. c_default = 'W/N'
  21.  
  22. DO Mempubs
  23. palette = .f.
  24. gchar = Chr(228)    && "get" character
  25. mchar = Chr(234)    && "menu" character
  26. struvar = Space(30)                              && DBF file spec
  27.  
  28. IF ! File('Screen.dbf')
  29.    DO MakeScreen
  30. ENDIF                                            && IF ! File('Screen.dbf') [line: 25]
  31.  
  32. IF ! File('ScrnGets.dbf')
  33.    DO MakeGets
  34. ENDIF                                            && IF ! File('ScrnGets.dbf') [line: 29]
  35.  
  36. IF ! File('ScrnMenu.dbf')
  37.    MakeMenu()                                    && see MEM_PROC.PRG
  38. ENDIF
  39.  
  40. IF ! File('ScrnRpts.dbf')
  41.    MakeRpts()
  42. ENDIF
  43.  
  44. IF File('Scrnpal.mem')
  45.    RESTORE FROM Scrnpal ADDITIVE                 && restore color palette
  46. ENDIF                                            && IF File('Scrnpal.mem') [line: 33]
  47.  
  48. USE Screen ALIAS Scr_file
  49.  
  50. Automem('PUB')
  51. IF ! File('Screen.ntx')
  52.    INDEX ON Scrn_name TO Screen
  53. ELSE                                             && IF ! File('Screen.ntx') [line: 40]
  54.    SET INDEX TO Screen
  55. ENDIF                                            && IF ! File('Screen.ntx') [line: 40]
  56.  
  57. SELECT 0
  58. USE ScrnGets
  59. IF ! File('ScrnGets.ntx') .OR. ! File('Sgets.ntx')
  60.    INDEX ON Scrn_name TO Sgets
  61.    INDEX ON Scrn_name+Str(G_row,2)+Str(G_col,2) TO ScrnGets
  62. ELSE                                             && IF ! File('ScrnGets.ntx') .OR. ! File('Sgets.ntx') [line: 48]
  63.    SET INDEX TO Sgets,ScrnGets
  64. ENDIF                                            && IF ! File('ScrnGets.ntx') .OR. ! File('Sgets.ntx') [line: 48]
  65. Automem('PUB')
  66. Automem('INIT')
  67.  
  68. SELECT 0
  69. USE ScrnMenu
  70. Automem('PUB')
  71.  
  72. IF ! File('ScrnMenu.ntx')
  73.    INDEX ON Scrn_name+Str(M_row,2)+Str(M_col,2) TO ScrnMenu
  74. ELSE
  75.    SET INDEX TO ScrnMenu
  76. ENDIF
  77.  
  78. SELECT 0
  79. USE ScrnRpts
  80. Automem('PUB')
  81.  
  82. IF ! File('ScrnRpts.ntx')
  83.    INDEX ON Scrn_name TO ScrnRpts
  84. ELSE
  85.    SET INDEX TO ScrnRpts
  86. ENDIF
  87.  
  88. SELECT Scr_file
  89. IF Type('par1') != 'U'
  90.    SEEK Upper(par1)
  91.    IF ! Found() .AND. Lastrec() > 0
  92.       GO TOP
  93.    ENDIF                                         && IF ! Found() .AND. Lastrec() > 0 [line: 59]
  94. ENDIF                                            && IF Type('par1') != 'U' [line: 57]
  95.  
  96.  
  97. memfile = Scrn_name
  98. memscrn = Screen
  99. undoscrn = Screen
  100. buffer1 = Screen
  101.  
  102.  
  103. fname = Space(20)
  104. memvar = Space(10)
  105. single = .t.                                     && default to single line box
  106. showgm = .f.                   && default to hide gets/menu char
  107.  
  108. Setcolor(c_statln1)
  109. @ 0,0 CLEAR TO 0,79
  110.  
  111. Setcolor(c_default)
  112. Scroll(1,0,24,79,0)
  113. Restscreen(St,Sl,Sb,Sr,memscrn)
  114. RestGets()
  115. RestMenu()
  116.  
  117. @ 1,0 SAY ''
  118. r = Row()
  119. c = Col()
  120. st = 1                                           && save screen top
  121. sl = 0                                           && save screen left
  122. sb = 24                                          && save screen bottom
  123. sr = 79                                          && save screen right
  124.  
  125. sct = 1                                          && scrap coords
  126. scl = 0
  127. scb = 24
  128. scr = 79
  129. scrap = ' '
  130.  
  131. memrow = 6
  132. memcol = 7
  133. changed = .f.
  134.  
  135. SetCancel(.f.)                                   && disable Alt-C
  136. is_scrap = .f.                                   && is scrap active?
  137.  
  138. DO WHILE .T.
  139.    choice = ' '
  140.    memfile = Scrn_name
  141.  
  142.    @ r,c SAY ''
  143.  
  144.    DO StatLine
  145.    key = Inkey(0)
  146.    IF key < 32
  147.       DO CtrlKey
  148.       LOOP
  149.    ELSEIF key >= 271                             && DO CtrlKey [line: 112]
  150.       buffer1 = Savescreen(1,0,24,79)
  151.       DO AltKey
  152.       undoscrn = buffer1
  153.       LOOP
  154.    ELSE                                          && DO CtrlKey [line: 112]
  155.       buffer1 = Savescreen(1,0,24,79)
  156.       choice = Chr(key)
  157.    ENDIF                                         && DO CtrlKey [line: 112]
  158.  
  159.    DO CASE
  160.       CASE choice $ 'Aa'                         && colors
  161.          DO Memcolor
  162.  
  163.       CASE choice $ 'Bb'
  164.          DO MakeBOX
  165.          undoscrn = buffer1
  166.  
  167.       CASE choice $ 'Cc'                         && copy block
  168.          DO CopyBlock
  169.          undoscrn = buffer1
  170.  
  171.       CASE choice $ 'Dd'                         && delete
  172.          IF Deleted()
  173.             RECALL
  174.          ELSE                                    && IF Deleted() [line: 137]
  175.             del = ' '
  176.             oldcolor = Setcolor(c_field)
  177.             @ 0,0 SAY 'DELETE '+scrn_name+'?' GET del PICT '!'
  178.             READ
  179.             IF del = 'Y'
  180.                DELETE
  181.             ENDIF                                && IF del = 'Y' [line: 144]
  182.             Setcolor(oldcolor)
  183.          ENDIF                                   && IF Deleted() [line: 137]
  184.  
  185.       CASE choice $ 'Ee'                         && erase block
  186.          DO EraseBlock
  187.          undoscrn = buffer1
  188.  
  189.       CASE choice $ 'Ff'                         && find (browze) screen
  190.          DO Memfind
  191.  
  192.       CASE choice $ 'Gg'                         && GET processing
  193.          IF Empty(Scrn_name)
  194.             memfile = Scrn_name
  195.             oldcolor = Setcolor(c_field)
  196.             @ 0,10 SAY 'ENTER Screen NAME: ' GET memfile PICT '@K!'
  197.             READ
  198.          ENDIF                                   && IF Empty(Scrn_name) [line: 158]
  199.          DO MemGets
  200.  
  201.       CASE choice $ 'Hh'                         && horizontal line
  202.          DO Make_Hline
  203.          undoscrn = buffer1
  204.  
  205.       CASE choice $ 'Ii'                         && import from file
  206.          DO Memimp
  207.  
  208.       CASE choice $ 'Ll'                         && load
  209.  
  210. *--------------
  211. * List function
  212. * Commented out
  213. *--------------
  214. *         recno = Recno()
  215. *         GO TOP
  216. *         dev = Space(1)
  217. *         @ 24,0 CLEAR
  218. *         @ 24,10 SAY '<P>rinter, <S>creen, <F>ile' GET dev PICT '!'
  219. *         READ
  220. *         IF ! Empty(dev)
  221. *            DO CASE
  222. *               CASE dev = 'P'
  223. *                  LIST Scrn_name,St,Sl,Sb,Sr TO PRINT
  224. *                  EJECT
  225. *               CASE dev = 'S'
  226. *                  CLEAR
  227. *                  speed = .2
  228. *                  LIST Interupt(Scrn_name),St,Sl,Sb,Sr
  229. *                  Inkey(0)
  230. *               CASE dev = 'F'
  231. *                  fname = Space(20)
  232. *                  @ 24,0 CLEAR
  233. *                  @ 24,10 SAY 'ENTER FILE NAME:' GET fname
  234. *                  READ
  235. *                  SET PRINTER TO (fname)
  236. *                  LIST Scrn_name,St,Sl,Sb,Sr TO PRINT
  237. *                  SET PRINTER TO
  238. *                  fname = Space(20)
  239. *            ENDCASE
  240. *         ENDIF
  241. *         GO recno
  242. *         Restscreen(1,0,24,79,buffer1)
  243.  
  244.       CASE choice $ 'Mm'                         && move block
  245.          DO MoveBlock
  246.          undoscrn = buffer1
  247.  
  248.       CASE choice $ 'Nn'                         && Pick a NONASCII char
  249.          savrow = r
  250.          savcol = c
  251.          savchr = Nonascii(memrow,memcol)
  252.          IF ! Empty(savchr)
  253.             @ savrow,savcol SAY savchr
  254.          ENDIF                                   && IF ! Empty(savchr) [line: 217]
  255.          undoscrn = buffer1
  256.  
  257.       CASE choice $ 'Pp'                         && paint block
  258.          DO Paint
  259.          undoscrn = buffer1
  260.  
  261.       CASE choice $ 'Rr'                         && repeat char a number of times
  262.          oldcolor = Setcolor(c_field)
  263.          rchar = ' '
  264.          rcount = 0
  265.          @ 0,10 SAY 'Repeat Char: ' GET rchar
  266.          @ 0,25 SAY 'Repeat Count: ' GET rcount PICT '99'
  267.          READ
  268.          IF ! Empty(rcount)
  269.             Setcolor(oldcolor)
  270.             @ r,c SAY Replicate(rchar,rcount)
  271.             undoscrn = buffer1
  272.          ENDIF                                   && IF ! Empty(rcount) [line: 236]
  273.          Setcolor(oldcolor)
  274.  
  275.       CASE choice $ 'Ss'                         && save
  276.          DO SaveScrn WITH 1,0,24,79,buffer1
  277.          changed = .f.
  278.  
  279.       CASE choice $ 'Tt'                         && text mode
  280.          DO MemText
  281.          undoscrn = buffer1
  282.  
  283.       CASE choice $ 'Uu'                         && Undo
  284.          Restscreen(1,0,24,79,undoscrn)
  285.  
  286.       CASE choice $ 'Vv'                         && Vertical line
  287.          DO Make_Vline
  288.          undoscrn = buffer1
  289.  
  290.       CASE choice $ 'Ww'                         && walk about mode
  291.          DO WalkAbout
  292.          undoscrn = buffer1
  293.  
  294.       CASE choice $ 'Xx'                         && EXIT POINT
  295.          IF changed
  296.             DO AskToSave
  297.          ENDIF                                   && IF changed [line: 263]
  298.  
  299.          EXIT
  300.  
  301.       CASE choice $ 'Zz'
  302.          IF changed
  303.             DO AskToSave
  304.          ENDIF                                   && IF changed [line: 270]
  305.  
  306.          GO BOTTOM
  307.          SKIP
  308.          Scroll(1,0,24,79,0)
  309.          memscrn = Savescreen(1,0,24,79)
  310.          st = 1
  311.          sl = 0
  312.          sb = 24
  313.          sr = 79
  314.          Restscreen(M->st,M->sl,M->sb,M->sr,memscrn)
  315.  
  316.       OTHERWISE
  317.          Alert()
  318.    ENDCASE                                       &&  [line: 283]
  319. ENDDO                                            &&  [line: 273]
  320. SET DELETED OFF
  321.  
  322. SELECT Scr_file
  323. LOCATE FOR Deleted()
  324. IF Found()
  325.    DO WHILE ! Eof()
  326.       SELECT ScrnGets
  327.       SEEK Scr_file->Scrn_name
  328.       IF Found()
  329.          DO WHILE Scrn_name == Scr_file->Scrn_name .AND. ! Eof()
  330.             DELETE
  331.             SKIP
  332.          ENDDO                                   && DO WHILE Scrn_name == Scr_file->Scrn_name .AND. ! Eof() [line: 297]
  333.       ENDIF                                      && IF Found() [line: 296]
  334.       SELECT Scr_file
  335.       CONTINUE
  336.    ENDDO                                         && DO WHILE ! Eof() [line: 293]
  337.    PACK
  338.  
  339.    DO WHILE ! Eof()
  340.       SELECT ScrnMenu
  341.       SEEK Scr_file->Scrn_name
  342.       IF Found()
  343.          DO WHILE Scrn_name == Scr_file->Scrn_name .AND. ! Eof()
  344.             DELETE
  345.             SKIP
  346.          ENDDO                                   && DO WHILE Scrn_name == Scr_file->Scrn_name .AND. ! Eof() [line: 297]
  347.       ENDIF                                      && IF Found() [line: 296]
  348.       SELECT Scr_file
  349.       CONTINUE
  350.    ENDDO                                         && DO WHILE ! Eof() [line: 293]
  351.    PACK
  352. ENDIF                                            && IF Found() [line: 292]
  353.  
  354. SELECT ScrnGets
  355. LOCATE FOR Deleted()
  356. IF Found()
  357.    DELETE ALL FOR Empty(Scrn_name)
  358.    PACK
  359. ENDIF                                            && IF Found() [line: 310]
  360.  
  361. SELECT ScrnMenu
  362. LOCATE FOR Deleted()
  363. IF Found()
  364.    DELETE ALL FOR Empty(Scrn_name)
  365.    PACK
  366. ENDIF
  367.  
  368. CLOSE DATA   
  369. RETURN
  370.  
  371. *----------------------------
  372. *         Author: Ed Phillips
  373. *   Date Created: 02/22/91
  374. *   Time Created: 07:44:36
  375. *----------------------------
  376. PROCEDURE StatLine
  377.    PARAMETERS cMsg
  378.    PRIVATE oldcolor, r, c
  379.    oldcolor = Setcolor(c_statln1)
  380.  
  381.    r = Row()
  382.    c = Col()
  383. *          1         2         3         4         5         6         7
  384. *01234567890123456789012345678901234567890123456789012345678901234567890123456789
  385. *                              ccccccccccc S  ccccccc   -    nn,nn
  386.    @ 0,0 CLEAR TO 0,79
  387.  
  388.    IF Type('cMsg') = 'C'
  389.       @ 0,0 SAY cMsg
  390.    ENDIF
  391.  
  392.    IF single
  393.       @ 0,55 SAY Chr(218)
  394.    ELSE                                          && IF single [line: 332]
  395.       @ 0,55 SAY Chr(201)
  396.    ENDIF                                         && IF single [line: 332]
  397.    @ 0,60 SAY Strzero(r,2)+','+Strzero(c,2)
  398.    @ 0,30 SAY ' '+Scrn_name
  399.    IF Deleted()
  400.       @ 0,30 SAY '*'
  401.    ENDIF                                         && IF Deleted() [line: 339]
  402.    IF IsSub()
  403.       @ 0,42 SAY 'S'
  404.    ELSE                                          && IF IsSub() [line: 342]
  405.       @ 0,42 SAY ' '
  406.    ENDIF                                         && IF IsSub() [line: 342]
  407.  
  408.    SELECT Scrngets
  409.    SEEK Scr_file->Scrn_name
  410.    IF Found()
  411.       @ 0,75 SAY 'G'
  412.    ENDIF
  413.  
  414.    SELECT ScrnMenu
  415.    SEEK Scr_file->Scrn_name
  416.    IF Found()
  417.       @ 0,76 SAY 'M'
  418.    ENDIF
  419.  
  420.    SELECT ScrnRpts
  421.    SEEK Scr_file->Scrn_name
  422.    IF Found()
  423.       @ 0,77 SAY 'R'
  424.    ENDIF
  425.  
  426.    SELECT Scr_file
  427.    Setcolor(oldcolor)
  428.    @ 0,45 SAY ' Color '
  429.    @ r,c SAY ''
  430. RETURN
  431.  
  432. *----------------------------
  433. *         Author: Ed Phillips
  434. *   Date Created: 02/24/91
  435. *----------------------------
  436. PROCEDURE SaveScrn
  437.    PARAMETERS sst,ssl,ssb,ssr,buffname
  438.    PRIVATE oldcolor, oldname, nRec
  439.  
  440.    SELECT Scr_file
  441.    oldcolor = Setcolor(c_field)
  442.    @ 0,0 CLEAR TO 0,39
  443.    IF Empty(Scrn_name)
  444.       memfile = Scrn_name
  445.    ENDIF                                         && IF Empty(Scrn_name) [line: 364]
  446.    oldname = memfile
  447.    nRec = Recno()
  448.  
  449.    @ 0,0 SAY 'ENTER Screen NAME:' GET memfile PICT '@K!'
  450.    READ
  451.  
  452.    IF ! Empty(memfile) .AND. Lastkey() != esc
  453.       mde = 'EDIT'
  454.       explode = Explode
  455.       ok = .t.
  456.  
  457.       SEEK memfile
  458.       IF ! Found()
  459.          mde = 'ADD'
  460.          explode = 9
  461.          APPEND BLANK
  462.       ELSE                                       && IF ! Found() [line: 378]
  463.          @ 0,0 CLEAR TO 0,39
  464.          Alert()
  465.          @ 0,0 SAY 'SCREEN already exists, Replace it? (Y/N)' GET ok PICT 'Y'
  466.          READ
  467.       ENDIF                                      && IF ! Found() [line: 378]
  468.       IF ok
  469.          buffname = Strtran(buffname,gchar,' ')
  470.          REPL Scrn_name WITH memfile, Screen WITH buffname, St WITH sst,;
  471.          Sl WITH ssl, Sb WITH ssb, Sr WITH ssr, Explode WITH M->explode
  472.  
  473.          *----------------------------
  474.          * Update GETS if name changed
  475.          *----------------------------
  476.          IF oldname != memfile .AND. !Empty(oldname)
  477.             SELECT Scrngets
  478.             SEEK oldname
  479.             IF Found()
  480.                IF mde = 'EDIT'
  481.                   SET ORDER TO 0
  482.                   GO TOP
  483.                   REPLACE ALL Scrn_name WITH memfile FOR Scrn_name == oldname
  484.                   SET ORDER TO 1
  485.                ELSE                              && IF mde = 'EDIT' [line: 399]
  486.                   DO WHILE Scrn_name == oldname .AND. ! Eof()
  487.                      re = Recno()
  488.                      Automem('STUP')
  489.                      scrn_name = memfile
  490.                      APPEND BLANK
  491.                      Automem('REPL')
  492.                      GO re
  493.                      SKIP
  494.                   ENDDO                          && DO WHILE Scrn_name == oldname .AND. ! Eof() [line: 405]
  495.                ENDIF                             && IF mde = 'EDIT' [line: 399]
  496.             ENDIF                                && IF Found() [line: 398]
  497.             SELECT Scr_file
  498.          ENDIF                                   && IF oldname != memfile .AND. !Empty(oldname) [line: 395]
  499.       ELSE
  500.          memfile = oldname
  501.          GO nRec
  502.       ENDIF                                      &&  [line: 391]
  503.    ENDIF
  504.    Setcolor(oldcolor)
  505. RETURN
  506.  
  507. *----------------------------
  508. *         Author: Ed Phillips
  509. *   Date Created: 02/28/91
  510. *   Time Created: 10:01:53
  511. *----------------------------
  512. PROCEDURE AskToSave
  513.    PRIVATE oldcolor, keep
  514.  
  515.    oldcolor = Setcolor(c_field)
  516.    keep = .t.
  517.    Alert()
  518.    @ 0,0 CLEAR TO 0,39
  519.    @ 0,0 SAY 'Screen not saved.  Save?' GET keep PICT 'Y'
  520.    READ
  521.    IF keep
  522.       DO SaveScrn WITH M->st,M->sl,M->sb,M->sr,buffer1
  523.    ENDIF                                         && IF keep [line: 437]
  524.    changed = .f.
  525.    SetColor(oldcolor)
  526. RETURN
  527. * EOF: MEMSCRN.PRG
  528.