[原创]SUBFILE中数值自动累加功能(RPGLE技巧一则)

bobofish29

整理了一个能对SUBFILE中的列出的数据进行自动累加的技巧,本人自觉得非常实用,特地拿出来和大家分享!
DSPF代码:

1. 
   
2. A                                      DSPSIZ(24 80 *DS3)               
   
3. A                                      CA03(99)                        
   
4. A*-------------------------------------------------------------------  
   
5. A          R SUBDAT                    SFL                               *SUBFILE
   
6. A            SUBOPT         1A  B  3  3CHECK(ER)               *选项字段         
   
7. A            SUBAMT         7Y 2B  3  9EDTWRD('     .  ')      *数值字段         
   
8. A*-------------------------------------------------------------------  
   
9. A          R SUBCTL                    SFLCTL(SUBDAT)           *SUB CONTROL         
   
10. A                                      OVERLAY                          
    
11. A  65                                  SFLDSP                           
    
12. A  75                                  SFLDSPCTL                        
    
13. A  30                                  SFLINZ                           
    
14. A  50                                  SFLCLR                           
    
15. A  40                                  SFLEND(*MORE)                    
    
16. A                                      SFLSIZ(0099)                     
    
17. A                                      SFLPAG(0012)                     
    
18. A            DSPRCD         4S 0H      SFLRCDNBR(CURSOR)      *显示当前光标行数的字段         
    
19. A            RELRCD         5S 0H                                              *用于控制光标行数的字段
    
20. A                                  2  2'Opt.   Amount  '               
    
21. A                                      DSPATR(HI)                       
    
22. A                                      DSPATR(UL)                       
    
23. A*-------------------------------------------------------------------  
    
24. A          R TOTFMT                                                     
    
25. A                                      OVERLAY                          
    
26. A                                 18  1'Total:'                        
    
27. A            TOTAMT         8Y 2O 18  8EDTCDE(3)                   *显示累加结果
    

复制代码

RPGLE代码:

1. 
   
2. FCNDDBG    CF   E             WORKSTN SFILE(SUBDAT:RRN)               
   
3. C*-------------------------------------------------------------------  
   
4. C**   MAIN ROUTINE                                                     
   
5. C*-------------------------------------------------------------------  
   
6. C                   DOW       *IN99='0'                                 
   
7. C*WRITE DATA TO SUBDAT                                    *往SUBFILE里赋值                 
   
8. C     1             DO        20            X                 2 0      
   
9. C                   EVAL      SUBAMT=X * 10                             
   
10. C                   EVAL      RRN=RRN + 1                              
    
11. C                   WRITE     SUBDAT                                    
    
12. C                   CLEAR                   SUBDAT                     
    
13. C                   ENDDO                                               
    
14. C*DISPLAY SUBCTL                                                *显示SUBFILE和累加结果         
    
15. C     LOOP_TAG      TAG                                                
    
16. C                   WRITE     TOTFMT                                    
    
17. C                   SETON                                        657540
    
18. C                   EXFMT     SUBCTL                                    
    
19. C                   SETOFF                                       657540
    
20. C*CALCULATE TOTAL AMOUNT                                                
    
21. C                   IF        *IN99='0'                                 
    
22. C                   READC     SUBDAT                                 10   *读取SUBFILE的变化
    
23. C                   IF        *IN10='0'                                 
    
24. C                   IF        RRN=20                                    
    
25. C                   EVAL      RRN=1                                    
    
26. C                   ELSE                                                
    
27. C                   EVAL      RRN=RRN + 1                              
    
28. C                   EVAL      DSPRCD=RRN                                *操作后光标置于后一项
    
29. C                   EVAL      RELRCD=RRN                                
    
30. C*SELECT AMOUNT                                                         *累加操作
    
31. C                   EVAL      RRN=0                                    
    
32. C                   SETOFF                                       11     
    
33. C                   DOW       *IN11='0'                                 
    
34. C                   EVAL      RRN=RRN + 1                              
    
35. C     RRN           CHAIN     SUBDAT                             11     
    
36. C                   IF        *IN11='0' AND SUBOPT='Y'                  
    
37. C                   EVAL      TOTAMT=TOTAMT + SUBAMT                    
    
38. C                   ENDIF                                               
    
39. C                   ENDDO                                               
    
40. C                                                                       
    
41. C                   ENDIF                                               
    
42. C                   ENDIF                                               
    
43. C                   GOTO      LOOP_TAG                                 
    
44. C                   ENDIF                                               
    
45. C                                                                       
    
46. C                   ENDDO                                               
    
47. C                   SETON                                        LR     
    
48. C*-------------------------------------------------------------------   
    
49. C**   INITIALIZE                                                        
    
50. C*-------------------------------------------------------------------   
    
51. C     *INZSR        BEGSR                                               *初始化子程序
    
52. C                   SETON                                        50     
    
53. C                   WRITE     SUBCTL                                    
    
54. C                   SETOFF                                       50     
    
55. C                                                                       
    
56. C                   Z-ADD     *ZEROS        RRN               4 0      
    
57. C                   MOVEL     *BLANKS       TOTAMT                     
    
58. C                   Z-ADD     1             DSPRCD                     
    
59. C                   Z-ADD     1             RELRCD                     
    
60. C                                                                       
    
61. C                   ENDSR                                               
    

复制代码

图例:

tom9030

在哪呢？

bobofish29

操作实现的关键在:
1.DSPF中的KEYWORD

1. A            SUBOPT         1A  B  3  3CHECK(ER)

复制代码

CHECK(ER):当字段最后一个位置键入字符结束后,记录就由设置送出,类似于按下回车键(ENTER)
2.RPGLE中的READC
READC:读取SUBFILE中修改过的记录

xuguopeng

以后发这种原创最好能把代码加上注释或说明 让初学者都能看懂 我想会更好 加精~ 期待更多的原创出来

bobofish29

呵呵....我已经加了注释了!有问题随时答复!

michael9406

注释很清楚。看来楼主用的是中文系统了。。。

bobofish29

呵呵...我们公司用的是全英文的系统,那些注释是我发贴时加上去的,方便大家了解!

wildfish

不错，我们以前做这种录入的比较少，大多都是程序手动加

just400

up!

thursday

受用