|
|
Creating the Test File for the Data Editor
CRTPF FILE(TESTFILE) RCDLEN(128) TEXT('Test file for data editor') SIZE(*NOMAX)
|
The RPG for the Data Editor (Non-free form)
** WRITTEN BY : Booth Martin *
** DATE WRITTEN : 01/2007 *
** COMMENTS Full screen data editor. *
** *
**--------------------------------------------------------------------*
FDATAEDITFMcf e workstn
F sfile(SFL1 : SF1NUM)
FTESTFILE if a f 128 disk
* Prototypes.
D/copy InclSrc,pQCmdExc
D wNewRecords s 5 0 inz(30)
D wNdx s 5 0
D wcmd s 1024 varying
D NewRecordDS ds
D NewData like(DATA)
D QCMD PR ExtPgm('QCMDEXC')
D 1024 const
D 15 5 const
ITESTFILE NS
I 1 128 DATA
**====================================================================*
** MAINLINE-BEGIN *
**====================================================================*
* Display screen.
C exsr S1Main
* Exit.
C eval *inlr = *on
**====================================================================*
** MAINLINE-END *
**====================================================================*
*-------------------------------* Sub-Routine *
* ExitPgm() *---------------*
* Exit program. *
*-----------------------------------------------*
C ExitPgm begsr
C eval *inlr = *on
C return
C endsr
*-------------------------------* Sub-Routine *
* S1Main() *---------------*
* Screen - Main processing. *
*-----------------------------------------------*
C S1Main begsr
* Display screen.
C exsr S1Fill
* Loop until exit.
C dow *inkc = *off
C write S1CMD
C exfmt S1
C select
* F3=Exit.
C when *inkc = *on
C exsr ExitPgm
C other
C exsr SaveData
C endsl
C enddo
C endsr
*-------------------------------* Sub-Routine *
* S1Fill() *---------------*
* Screen - Fill screen. *
*-----------------------------------------------*
C S1Fill begsr
* Clear subfile.
C eval *in50 = *on
C write S1
C eval *in50 = *off
* Fill SFL.
C eval SF1NUM = *zero
* Read the file.
C *start setll TESTFILE
C read TESTFILE
C dow not %eof
C eval SF1NUM = SF1NUM + 1
C write SFL1
C read TESTFILE
C enddo
* Create some empty records for adding records.
C clear DATA
C for wNdx = 1 to wNewRecords
C eval SF1NUM = SF1NUM + 1
C write SFL1
C endfor
* Save values.
C eval SF1RECS = SF1NUM
C eval SF1TOP = 1
C endsr
*-------------------------------* Sub-Routine *
* SaveData() *---------------*
* Save the edited data *
*-----------------------------------------------*
C SaveData begsr
* Clear the data file.
C close TESTFILE
C eval wCmd = 'CLRPFM FILE(TESTFILE)'
C callp qcmd(wCmd:%len(wCmd))
C open TESTFILE
* Find the last filled record. ( This process ia to allow blank
* records in the file.)
C for SF1RECS = SF1NUM downto 1
C SF1RECS chain SFL1
C if DATA <> *blanks
C leave
C endif
C endfor
* Fill the data file with the data.
C for wNdx = 1 to SF1RECS
C wNdx chain SFL1
C eval NewData = DATA
C write TESTFILE NewRecordDS
C endfor
* Refill the subfile with the new data.
C exsr S1Fill
C endsr
|
The RPG for the Data Editor (Free form)
// WRITTEN BY : Booth Martin *
// DATE WRITTEN : 01/2007 *
// COMMENTS Full screen data editor. *
// *
//--------------------------------------------------------------------*
FDATAEDITFMcf e workstn
F sfile(SFL1 : SF1NUM)
FTESTFILE if a f 128 disk
// Prototypes.
D/copy InclSrc,pQCmdExc
D wNewRecords s 5 0 inz(30)
D wNdx s 5 0
D wcmd s 1024 varying
D NewRecordDS ds
D NewData like(DATA)
D QCMD PR ExtPgm('QCMDEXC')
D 1024 const
D 15 5 const
ITESTFILE NS
I 1 128 DATA
//====================================================================*
// MAINLINE-BEGIN *
//====================================================================*
// Display screen.
/FREE
exsr S1Main;
// Exit.
*inlr = *on;
//====================================================================*
// MAINLINE-END *
//====================================================================*
//-------------------------------* Sub-Routine *
// ExitPgm() *---------------*
// Exit program. *
//-----------------------------------------------*
begsr ExitPgm;
*inlr = *on;
return;
endsr;
//-------------------------------* Sub-Routine *
// S1Main() *---------------*
// Screen - Main processing. *
//-----------------------------------------------*
begsr S1Main;
// Display screen.
exsr S1Fill;
// Loop until exit.
dow *inkc = *off;
write S1CMD;
exfmt S1;
select;
// F3=Exit.
when *inkc = *on;
exsr ExitPgm;
other;
exsr SaveData;
endsl;
enddo;
endsr;
//-------------------------------* Sub-Routine *
// S1Fill() *---------------*
// Screen - Fill screen. *
//-----------------------------------------------*
begsr S1Fill;
// Clear subfile.
*in50 = *on;
write S1;
*in50 = *off;
// Fill SFL.
SF1NUM = *zero;
// Read the file.
setll *start TESTFILE;
read TESTFILE;
dow not %eof;
SF1NUM = SF1NUM + 1;
write SFL1;
read TESTFILE;
enddo;
// Create some empty records for adding records.
clear DATA;
for wNdx = 1 to wNewRecords;
SF1NUM = SF1NUM + 1;
write SFL1;
endfor;
// Save values.
SF1RECS = SF1NUM;
SF1TOP = 1;
endsr;
//-------------------------------* Sub-Routine *
// SaveData() *---------------*
// Save the edited data *
//-----------------------------------------------*
begsr SaveData;
// Clear the data file.
close TESTFILE;
wCmd = 'CLRPFM FILE(TESTFILE)';
qcmd(wCmd:%len(wCmd));
open TESTFILE;
// Find the last filled record. ( This process ia to allow blank
// records in the file.)
for SF1RECS = SF1NUM downto 1;
chain SF1RECS SFL1;
if DATA <> *blanks;
leave;
endif;
endfor;
// Fill the data file with the data.
for wNdx = 1 to SF1RECS;
chain wNdx SFL1;
NewData = DATA;
write TESTFILE NewRecordDS;
endfor;
// Refill the subfile with the new data.
exsr S1Fill;
endsr;
/END-FREE
|
The DDS for the Data Editor screen
******************************************************************
** WRITTEN BY : Booth Martin *
** DATE WRITTEN : 01-2007 *
** COMMENTS : Screen format simple data editor *
******************************************************************
A DSPSIZ(27 132 *DS4)
A PRINT
A ERRSFL
A CA03
*****************************************************************
A R SFL1 SFL
A DATA 128 B 9 2
*****************************************************************
A R S1 SFLCTL(SFL1)
A SFLPAG(0016)
A SFLSIZ(&SF1RECS)
A OVERLAY
A N50 SFLDSP
A N50 SFLDSPCTL
A N50 SFLEND(*SCRBAR *MORE)
A 50 SFLCLR
A RTNCSRLOC(&PM_RCD &PM_FLD)
A PM_RCD 10A H
A PM_FLD 10A H
A SF1NUM 4S 0H
A SF1RECS 5S 0P
A SF1TOP 4S 0H SFLRCDNBR(CURSOR *TOP)
A 1 2DATE
A EDTCDE(Y)
A 1 20' ___ __ -
A ____ __ _ __ -
A '
A 2 2TIME
A 2 20' / _ \ ___ _ / /_ ___ _-
A / __/___/ /(_)/ /_ ___ ____ -
A '
A 3 2'SYSTEM X'
A 3 20' / // // _ `// __// _ `/-
A / _/ / _ // // __// _ \ / __/ -
A '
A 4 20' /____/ \_,_/ \__/ \_,_/ -
A /___/ \_,_//_/ \__/ \___//_/ -
A '
A 4 2USER
A 6 2' -
A -
A 1 -
A 1 1 1'
A COLOR(TRQ)
A 7 2' 1 2 3 -
A 4 5 6 -
A 7 8 9 0 -
A 1 2 3'
A COLOR(TRQ)
A 8 2'1234567890123456789012345678901234-
A 56789012345678901234567890123456789-
A 01234567890123456789012345678901234-
A 56789012345678901234567890'
A COLOR(TRQ)
A DSPATR(UL)
*****************************************************************
A R S1CMD
A LINE130 130 26 2DSPATR(UL)
A COLOR(BLU)
A 27 3'F3=Exit'
A COLOR(BLU)
|
|
|
|
| |
