fork download
copy 
  1. ********************************
  2. *    CASE TWO  九九乘法        *
  3. ********************************
  4.  
  5. *>識別部
  6. IDENTIFICATION DIVISION.
  7. PROGRAM-ID. HRWYY2KF.
  8.  
  9. *>環境部
  10. ENVIRONMENT DIVISION.
  11. CONFIGURATION SECTION.
  12. SPECIAL-NAMES.
  13. 	CRT STATUS IS W-KEY-ENTERED.
  14.  
  15. *>資料部(定義工作變數及螢幕變數)
  16. DATA DIVISION.
  17. WORKING-STORAGE SECTION.
  18. *>宣告工作變數區
  19. 01 W-WRK.
  20. 	02 W-WRK1.
  21. 		03 W-WRK-NUM1 PIC 9(2) VALUE 0.
  22. 		03 W-WRK-NUM2 PIC 9(2) VALUE 0.
  23. 		03 W-WRK-ANS  PIC 9(2) VALUE 0.	
  24. 		03 W-WRK-FUN PIC X(1).
  25. 			88 W-WRK-FUN-OK VALUE "1","2","3","4","5","6","7","8".
  26. 		03 W-ERR PIC X(40).
  27. 			78 W-ERR-FUN VALUE "請輸入數字1~8，或按ESE跳出!".
  28.  
  29. 01	W-KEY-ENTERED		PIC 9(3).	        
  30. 	88 W-WRAP-DKY	    VALUE 0.
  31. 	88 W-ESC-KEY		VALUE 27.
  32. 	88 W-CR-KEY		    VALUE 13.
  33. 	88 W-LF-KEY		    VALUE 10.
  34. 	88 W-RETURN-EKY		VALUE 10,13.
  35. 	88 W-UP-KEY		    VALUE 52,1.
  36. 	88 W-DOWN-KEY		VALUE 53,2.
  37. 	88 W-PGUP-KEY		VALUE 67,3.
  38. 	88 W-PGDN-KEY		VALUE 68,4.
  39. 	88 W-HOME-KEY		VALUE 65,7.
  40. 	88 W-END-KEY		VALUE 66,8.
  41. 	88 W-LEFT-KEY		VALUE 50.
  42. 	88 W-RIGHT-KEY		VALUE 51.		
  43.  
  44. 01	W-WINDOW-INQ		PIC X(10).
  45. *>使用78值設定畫面大小(不用變數以免被塞入其他值)
  46. 78	W-WIN-LINE		 VALUE 7. 	
  47. 78	W-WIN-COL		 VALUE 1.
  48. 78	W-MENU-LINE		 VALUE 15. 
  49. 78	W-MENU-SIZE		 VALUE 80. 
  50. 78	W-MENU-TITLE     VALUE "<九九乘法>".
  51.  
  52. SCREEN SECTION.
  53. *>畫面設定
  54. 01	S-SCR.
  55. *>                    123456789012345678901234567890
  56. 	02 LINE 2, COL 2 "請輸入數字1~8，或按ESC跳出：".
  57.  
  58. *>設定畫面接收變數
  59. 01 S-ACCEPT, AUTO.
  60. 	02 S-ACCEPT-FUN  LINE 2 COL 31  PIC  X(1) USING W-WRK-FUN.
  61. *    02 S-ACCEPT-ANS  LINE 4 COL 2 PIC -- USING W-WRK-ANS.
  62.  
  63. *>設定錯誤訊息變數
  64. 01 S-ERR LINE 14, COL 24 PIC X(40) FROM W-ERR.
  65.  
  66. *>程式結束訊息
  67. 01 S-CONTINUE LINE 14,COL 10 "請按任意鍵繼續....".
  68.  
  69.  
  70. PROCEDURE DIVISION.
  71. *>主程式段
  72. F-MAIN-RTN.
  73.  
  74. *>呼叫畫面程式段
  75. 	PERFORM F-OPEN-WIN-RTN.
  76.  
  77. *>輸入及計算程式段
  78. 	PERFORM F-PROC-RTN THRU F-PROC-EXIT.
  79.  
  80. *>結束程式
  81. F-MAIN-EXIT.
  82. 	DISPLAY S-CONTINUE.
  83. 	ACCEPT OMITTED,LINE 14,COL 35 CONTROL KEY IN W-KEY-ENTERED.
  84. 	CLOSE WINDOW W-WINDOW-INQ.
  85.  
  86. *>回上一程式畫面	
  87. 	GOBACK.	
  88.  
  89. *>開啟程式畫面
  90. F-OPEN-WIN-RTN.
  91. 	DISPLAY WINDOW LINE W-WIN-LINE,COL W-WIN-COL,
  92. 		LINES W-MENU-LINE, SIZE W-MENU-SIZE,BOXED,SHADOW,
  93. 		CENTERED TITLE IS W-MENU-TITLE,
  94. 		WITH NO WRAP NO SCROLL,
  95. *>		將視窗部分原有的資料存起來
  96. 		POP-UP AREA IS W-WINDOW-INQ.
  97.  
  98. *>清空畫面並顯示初始狀態		
  99. F-PROC-RTN.
  100. 	DISPLAY " " BLANK SCREEN.
  101. 	DISPLAY S-SCR.
  102. 	DISPLAY S-ACCEPT.		
  103.  
  104. *>選擇數字1~8，按ESC時結束程式 (必需有ON EXCEPTION才能接收到功能鍵值)
  105. F-INFUN-RTN.	
  106. 	ACCEPT	S-ACCEPT-FUN ON EXCEPTION CONTINUE.
  107.  
  108. *>輸入錯誤時(非1~8),顯示錯誤訊息,並要求重新輸入	
  109. 	IF W-ESC-KEY THEN
  110. 		GO TO F-PROC-EXIT
  111. 	END-IF.
  112.  
  113. 	IF NOT W-WRK-FUN-OK THEN
  114. 		MOVE "FUN" TO W-ERR
  115. *>顯示錯誤訊息段F-ERR-RTN
  116. 		PERFORM F-ERR-RTN
  117. 		INITIALIZE W-WRK-FUN
  118. 		DISPLAY S-ACCEPT-FUN
  119. 		GO TO F-INFUN-RTN
  120. 	END-IF.
  121.  
  122. *>開始運算結果
  123. F-CAL-RTN
  124. *>開始運算結果(EVALUATE寫法)
  125. 	EVALUATE W-WRK-FUN
  126. 		WHEN "1"
  127. 			DISPLAY " "
  128. 			PERFORM VARYING W-WRK-NUM1 FROM 1 BY 1 UNTIL W-WRK-NUM1 > 9
  129. 				PERFORM VARYING W-WRK-NUM2 FROM 1 BY 1 UNTIL W-WRK-NUM2 > 9
  130. 					COMPUTE W-WRK-ANS = W-WRK-NUM1 * W-WRK-NUM2
  131.  
  132. 					DISPLAY W-WRK-NUM1"*"W-WRK-NUM2"="W-WRK-ANS" " WITH  NO ADVANCING  
  133.  
  134. 				END-PERFORM
  135. 				DISPLAY " "
  136. 			END-PERFORM
  137.  
  138. *			PERFORM VARYING W-WRK-NUM1 FROM 1 BY 1 UNTIL W-WRK-NUM1 > 9
  139. *				PERFORM VARYING W-WRK-NUM2 FROM 1 BY 1 UNTIL W-WRK-NUM2 > 9
  140. *					COMPUTE W-WRK-ANS = W-WRK-NUM1 * W-WRK-NUM2
  141. *					DISPLAY W-WRK-NUM1"*"W-WRK-NUM2"="W-WRK-ANS" "
  142. *					END-PERFORM
  143. *				
  144. *				INITIALIZE W-WRK1
  145. *				DISPLAY S-ACCEPT
  146. *				GO TO F-INFUN-RTN
  147. *			END-PERFORM
  148.  
  149. 		WHEN "2"
  150. 			DISPLAY " "
  151. 			PERFORM VARYING W-WRK-NUM1 FROM 1 BY 1 UNTIL W-WRK-NUM1 > 9
  152. 				PERFORM VARYING W-WRK-NUM2 FROM 1 BY 1 UNTIL W-WRK-NUM2+W-WRK-NUM1 > 10
  153. 					COMPUTE W-WRK-ANS = W-WRK-NUM1 * W-WRK-NUM2
  154.  
  155. 					DISPLAY W-WRK-NUM1"*"W-WRK-NUM2"="W-WRK-ANS" " WITH  NO ADVANCING  
  156.  
  157.  
  158. 				END-PERFORM
  159. 				DISPLAY " "
  160.  
  161. 			END-PERFORM
  162.  
  163. 		WHEN "3"
  164. 			DISPLAY " "
  165. 			PERFORM VARYING W-WRK-NUM1 FROM 1 BY 1 UNTIL W-WRK-NUM1 > 9
  166. 				PERFORM VARYING W-WRK-NUM2 FROM 1 BY 1 UNTIL W-WRK-NUM2 > W-WRK-NUM1
  167. 					COMPUTE W-WRK-ANS = W-WRK-NUM1 * W-WRK-NUM2
  168.  
  169. 					DISPLAY W-WRK-NUM1"*"W-WRK-NUM2"="W-WRK-ANS" " WITH  NO ADVANCING  
  170.  
  171. 				END-PERFORM
  172. 				DISPLAY " "
  173. 			END-PERFORM
  174.  
  175. 		WHEN "4"
  176. 			DISPLAY " "
  177. 			PERFORM VARYING W-WRK-NUM1 FROM 1 BY 1 UNTIL W-WRK-NUM1 > 9
  178. 				PERFORM VARYING W-WRK-NUM2 FROM 1 BY 1 UNTIL W-WRK-NUM2 > 9
  179. 					COMPUTE W-WRK-ANS = W-WRK-NUM1 * W-WRK-NUM2
  180.  
  181. 					IF W-WRK-NUM1 <= W-WRK-NUM2
  182. 						DISPLAY W-WRK-NUM1"*"W-WRK-NUM2"="W-WRK-ANS" " WITH  NO ADVANCING
  183. 					ELSE
  184. 						DISPLAY "         " WITH  NO ADVANCING
  185.  
  186. 					END-IF
  187. 				END-PERFORM
  188. 				DISPLAY " "
  189. 			END-PERFORM
  190.  
  191. 		WHEN "5"
  192. 			DISPLAY " "
  193. 			PERFORM VARYING W-WRK-NUM1 FROM 1 BY 1 UNTIL W-WRK-NUM1 > 9
  194. 				PERFORM VARYING W-WRK-NUM2 FROM 1 BY 1 UNTIL W-WRK-NUM2 > 9
  195. 					COMPUTE W-WRK-ANS = W-WRK-NUM1 * W-WRK-NUM2
  196.  
  197. 					IF W-WRK-NUM1 <= W-WRK-NUM2
  198. 						DISPLAY W-WRK-NUM1"*"W-WRK-NUM2"="W-WRK-ANS" " WITH  NO ADVANCING
  199. 					ELSE
  200. 						DISPLAY "         " WITH  NO ADVANCING
  201.  
  202. 					END-IF
  203. 				END-PERFORM
  204. 				DISPLAY " "
  205. 			END-PERFORM
  206.  
  207.  
  208. 		WHEN "6"
  209. 			COMPUTE W-WRK-ANS = 6*6
  210.  
  211. 		WHEN "7"
  212. 			COMPUTE W-WRK-ANS = 7*7
  213.  
  214. 		WHEN "8"
  215. 			COMPUTE W-WRK-ANS = 8*8
  216.  
  217. 	END-EVALUATE.
  218.  
  219.  
  220. 	GO TO F-INFUN-RTN.
  221.  
  222.  
  223.  
  224. F-PROC-EXIT.
  225. 	EXIT.		
  226.  
  227. F-ERR-RTN.
  228. *	IF NOT W-WRK-SURE-OK THEN
  229. *	DISPLAY S-ERR FROM W-ERR-SURE 
  230. *	DISPLAY "請輸入數字1~8，或按ESE跳出：" AT LINE 20, COL 10
  231. *	ACCEPT OMITTED, LINE 20, COL 20 CONTROL KEY IN W-KEY-ENTERED
  232. *	MOVE " " TO W-WRK SURE
  233. *	INITIALIZE W-ERR
  234. *	DISPLAY S-ERR FROM W-ERR
  235. *	GO TO F-INNUM-RTN.
  236.  
  237. *>輸入錯誤訊息
  238. 	EVALUATE W-ERR
  239. 		WHEN "FUN"
  240. 			MOVE W-ERR-FUN TO W-ERR
  241. 	END-EVALUATE.
  242.  
  243. 	DISPLAY S-ERR.
  244. 	ACCEPT OMITTED, LINE 14, COL 24 CONTROL KEY IN W-KEY-ENTERED.
  245. 	INITIALIZE W-ERR.
  246. 	DISPLAY S-ERR.
  247.  
  248. F-ERR-EXIT. 
  249. 	EXIT.
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
prog.cob:1: Error: Invalid indicator 'A' at column 7
stdout
copy 
Standard output is empty
https://ideone.com/7FtqXx
language:
Cobol (gnucobol 2.2.0)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!