[原创]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                                               
    

复制代码

图例:

ypzhou25

算法有误  总值应该是 780

ypzhou25

{:3_200:}学习

0406410525

谢谢楼主提供的源代码。有两个小的问题：1只能加不能减。2最后一行的数初始时加不上。现加以小改，以示参考 ...
leonfun 发表于 2005-07-28 13:04

在DSPF定义隐藏field更方便吧
重新计算时只要先减掉隐藏field的值再加上新的值就可以了

ping222s

total的值怎么是840？

ping222s

厉害。。。感谢楼主，收藏了。。

qiulinhe

good sharing~~

pmf

对RPGLE程序作了一些修改，不使用goto也可以实现。

     FMOUTDSPF  CF   E             WORKSTN SFILE(SUBDAT:RRN)
     C*-
     C**   MAIN ROUTINE
     C*-
     C                   DOW       *IN99='0'
     C*WRITE DATA TO SUBDAT                                            
     C     1             DO        20            X                 2 0
     C                   EVAL      SUBAMT=X * 10
     C                   EVAL      RRN=RRN + 1
     C                   WRITE     SUBDAT
     C                   CLEAR                   SUBDAT
     C                   ENDDO
     C*DISPLAY SUBCTL                                                       
     C                   Move      '0'           Tag               1
     C                   DoW       Tag = '0'
     C                   WRITE     TOTFMT
     C                   SETON                                        657540
     C                   EXFMT     SUBCTL
     C                   SETOFF                                       657540
     C                   If        *IN99='1'
     C                   Leave
     C                   EndIf
     C*CALCULATE TOTAL AMOUNT
     C                   IF        *IN99='0'
     C                   READC     SUBDAT                                 10SUBFILE
     C                   IF        *IN10='0'
     C                   IF        RRN=20
     C                   EVAL      RRN=1
     C                   EVAL      DSPRCD=RRN                                   
     C                   EVAL      RELRCD=RRN
     C                   ELSE
     C                   EVAL      RRN=RRN + 1
     C                   EVAL      DSPRCD=RRN                                   
     C                   EVAL      RELRCD=RRN
     C                   EndIf
     C*SELECT AMOUNT
     C                   EVAL      RRN=0
     C                   SETOFF                                       11
     C                   Eval      Totamt=0
     C                   DOW       *IN11='0'
     C                   EVAL      RRN=RRN + 1
     C     RRN           CHAIN     SUBDAT                             11
     C                   IF        *IN11='0' AND SUBOPT='Y'
     C                   EVAL      TOTAMT=TOTAMT + SUBAMT
     C                   ENDIF
     C                   ENDDO
     C                   ENDIF
     C                   Iter
     C                   ENDIF
     C                   ENDDO
     C                   ENDDO
     C                   SETON                                        LR
     C                   Return
     C*----------------------------------------------------------
     C**   INITIALIZE
     C*----------------------------------------------------------
     C     *INZSR        BEGSR                                              
     C                   SETON                                        50
     C                   WRITE     SUBCTL
     C                   SETOFF                                       50
     C                   Z-ADD     *ZEROS        RRN               4 0
     C                   MOVEL     *BLANKS       TOTAMT
     C                   Z-ADD     1             DSPRCD
     C                   Z-ADD     1             RELRCD
     C                   ENDSR


pachenjun

我把上面的两段程序都原样的在自己的系统里写了下来.可为什么编译时通不过呢?

快乐狗

还是不明白，光标定位如何实现的