home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / MARTIN.ZIP / EXAMPL03.PRG < prev    next >
Encoding:
Text File  |  1990-06-02  |  2.5 KB  |  127 lines
  1. ********************************
  2. * EXAMPL03.PRG                 *
  3. * Written By Gregory A. Martin *
  4. ********************************
  5.  
  6. * This program examines how a network affects Clipper's view of a file.
  7. * NOTE:  This program (unlike example 1-7) is runnable.
  8.  
  9. PRIVATE Choice
  10.  
  11. DO Startup
  12.  
  13. IF .not. G_USE("Exampl03", "", "Example", .f., .f.)
  14.   RETURN
  15. ENDIF
  16.  
  17. DO PaintScreen
  18. DO WHILE .t.
  19.   DO UpdateScreen
  20.   Choice = GetChoice()
  21.   DO CASE
  22.     CASE Choice = 1
  23.       * DO Nothing
  24.     CASE Choice = 2
  25.       DO EditRec
  26.     CASE Choice = 3
  27.       DO GotoRecord
  28.     CASE Choice = 4
  29.       DO SkipRecord
  30.     CASE Choice = 5
  31.       G_RLOCK(forever)
  32.     CASE Choice = 6
  33.       UNLOCK
  34.     CASE Choice = 7
  35.       SKIP 0
  36.     CASE Choice = 8
  37.       COMMIT
  38.     CASE Choice = 9
  39.       APPENDBLANK(.f.)
  40.     CASE Choice = 10
  41.       EXIT
  42.   ENDCASE
  43. ENDDO
  44.  
  45. USE
  46. RETURN
  47.  
  48.  
  49. PROCEDURE PaintScreen
  50. SET COLOR TO &SCR_color
  51. CLEAR SCREEN
  52. SET COLOR TO &SAY_color
  53. @ 06, 08 TO 17, 28 DOUBLE
  54. @ 08, 38 TO 14, 67
  55. @ 09, 41 SAY "Record Number:"
  56. @ 11, 49 SAY "EOF():"
  57. @ 13, 40 SAY "Field Contents:"
  58. RETURN
  59.  
  60.  
  61. PROCEDURE UpdateScreen
  62. SET COLOR TO &GET_color
  63. @ 09, 56 SAY RECNO() PICTURE "99"
  64. @ 11, 56 SAY IIF(EOF(), "TRUE ", "FALSE")
  65. @ 13, 56 SAY Example->String
  66. RETURN
  67.  
  68.  
  69. FUNCTION GetChoice
  70. PRIVATE Key
  71. SET COLOR TO &SAY_color, &GET_color
  72. @ 07, 10 PROMPT "1. Repaint Screen"
  73. @ 08, 10 PROMPT "2. Edit Record   "
  74. @ 09, 10 PROMPT "3. GOTO Record __"
  75. @ 10, 10 PROMPT "4. SKIP __       "
  76. @ 11, 10 PROMPT "5. RLOCK()       "
  77. @ 12, 10 PROMPT "6. UNLOCK        "
  78. @ 13, 10 PROMPT "7. SKIP 0        "
  79. @ 14, 10 PROMPT "8. COMMIT        "
  80. @ 15, 10 PROMPT "9. APPEND BLANK  "
  81. @ 16, 10 PROMPT "Q. Quit          "
  82. Key = 1
  83. MENU TO Key
  84. IF Key = 0
  85.   Key = 10
  86. ENDIF
  87. RETURN(Key)
  88.  
  89.  
  90. PROCEDURE EditRec
  91. PRIVATE String
  92. String = Example->String
  93. SET COLOR TO &SCR_color, &GET_color,,, &SEL_color
  94. @ 23, 22 SAY "Enter New String Contents" GET m->String
  95. READ
  96. IF LASTKEY() <> Esc
  97.   REPLACE Example->String WITH m->String
  98. ENDIF
  99. @ 23, 22
  100. RETURN
  101.  
  102.  
  103. PROCEDURE GotoRecord
  104. PRIVATE RecNo
  105. RecNo = RECNO()
  106. SET COLOR TO &SCR_color, &GET_color,,, &SEL_color
  107. @ 23, 25 SAY "Enter Record Number To GOTO" GET m->RecNo PICTURE "99"
  108. READ
  109. IF LASTKEY() <> Esc
  110.   GOTO RecNo
  111. ENDIF
  112. @ 23, 25
  113. RETURN
  114.  
  115.  
  116. PROCEDURE SkipRecord
  117. PRIVATE SkipNo
  118. SkipNo = 0
  119. SET COLOR TO &SCR_color, &GET_color,,, &SEL_color
  120. @ 23, 29 SAY "Enter Value To SKIP" GET m->SkipNo PICTURE "99"
  121. READ
  122. IF LASTKEY() <> Esc
  123.   SKIP SkipNo
  124. ENDIF
  125. @ 23, 29
  126. RETURN
  127.