Rpg Free: Create a Window to display a program message

I’m tired of one-line messages. Too short. The average user needs clear and comprehensive messages.

Then I need a large enough window to display a clear and complete message.

Why not use a SUBFILE?

A SUBFILE program can handle a list of many lines, a clear and complete message is just a list of many text lines!

Here’s how I did it

I need a table that contains the messages.

—

— RUNSQLSTM SRCFILE(VDOTEST1/QSOURCE) SRCMBR(W03AM00F)

—

CREATE TABLE VDOTEST1/W03AM00F (

W3FANN CHARACTER(1) NOT NULL WITH DEFAULT,

W3TPMS CHARACTER(6) NOT NULL WITH DEFAULT,

W3COD0 NUMERIC(4, 0) NOT NULL WITH DEFAULT,

W3RIG0 NUMERIC(2, 0) NOT NULL WITH DEFAULT,

W3TXT0 CHARACTER(078) NOT NULL WITH DEFAULT

)

RCDFMT W03AM

;

Let’s populate the table:

INSERT INTO VDOTEST1/W03AM00F (W3TPMS, W3COD0, W3RIG0, W3TXT0)

values (‘INFO’,0001,01,’Program message 0001 row 01′)

INSERT INTO VDOTEST1/W03AM00F (W3TPMS, W3COD0, W3RIG0, W3TXT0)

values (‘INFO’,0001,02,’Program message 0001 row 02′)

INSERT INTO VDOTEST1/W03AM00F (W3TPMS, W3COD0, W3RIG0, W3TXT0)

values (‘INFO’,0001,03,’Program message 0001 row 03′)

…

… we suppose the text is very long…

INSERT INTO VDOTEST1/W03AM00F (W3TPMS, W3COD0, W3RIG0, W3TXT0)

values (‘INFO’,0001,21,’Program message 0001 row 21′)

Now let’s build the window.

Here is the Display file:

W03A00FM.DSPF

DSPSIZ(*DS4)

CHGINPDFT(CS UL HI)

INDARA

CA03(03 ‘F3=Exit’)

REF(W03AM00F)

*————————————————————————-

R SFL1 SFL

*————————————————————————-

S1TXT0 R 78 1 1REFFLD(W3TXT0) DSPATR(HI)

*————————————————————————-

R FMT01 SFLCTL(SFL1)

*————————————————————————-

SFLPAG(0010)

SFLSIZ(&NBRRECS)

OVERLAY

N50 SFLDSP SFLDSPCTL

50 SFLCLR

91 SFLEND(*MORE)

WINDOW(6 5 12 78)

WDWTITLE((*TEXT ‘Program message’))

WDWTITLE((*TEXT ‘Press F3 to

continue’) *BOTTOM)

SF1NUM 4S 0H

NBRRECS 5S 0P

Here is the SQLRPGLE source:

W03A00.SQLRPGLE

**FREE

ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no);

dcl-f W03A00FM workstn indds(Dspf) sfile(SFL1 : SF1NUM);

dcl-c MaxSFLrec 0100 ;

dcl-s ReLoadSFL ind inz(*on) ;

dcl-ds Dspf qualified ;

Exit ind pos(03) inz(*off) ;

SflClr ind pos(50) inz(*off) ;

SflEnd ind pos(91) inz(*off) ;

end-ds ;

dcl-ds RecordDs;

W3COD0 zoned(004);

W3RIG0 zoned(002);

W3TXT0 char(078);

end-ds;

dcl-pi W03A00 ;

pW3COD0 like(W3COD0);

end-pi ;

// Both “exec sql” is not executed but needed at compile time.

// It must be placed just after the last “dcl” declaration.

// LANGIDSHR defines the sort sequence as a “shared-weight sort table”,

// upper/lower insensitive, special characters are treated

// “{” as “A”

// “]” as “E” and so on.

exec sql set option Commit = *None;

exec sql set option SRTSEQ = *LANGIDSHR;

// preapre the data recordset

exec sql declare C1 cursor for

select

W3COD0,

W3RIG0,

W3TXT0

from W03AM00F

where W3COD0 = :pW3COD0

order by W3COD0, W3RIG0

for read only;

//*********************************************************************

// Start working…

//*********************************************************************

pW3COD0 = pW3COD0;

ReLoadSFL = *on;

dow Dspf.Exit = *off;

if ReLoadSFL;

LoadSFL();

endif;

exfmt FMT01;

select;

when Dspf.Exit; // F3=Exit

leave;

// call a program or a subroutine

other; // Read user options

endsl;

enddo;

exec sql close C1;

*inlr = *on;

//*********************************************************************

dcl-proc LoadSFL; // Load subfile

//*********************************************************************

ReLoadSFL = *off;

// Clear subfile

Dspf.SflClr = *on;

write FMT01;

Dspf.SflClr = *off;

// Load SFL

SF1NUM = *zero;

exec sql close C1;

exec sql open C1;

// Read recordset

dow Sqlcode = 0 and SF1NUM < MaxSFLrec;

exec sql fetch C1 into :RecordDS;

if sqlcode = 0;

S1TXT0 = W3TXT0;

SF1NUM += 1;

write SFL1;

else;

Dspf.SflEnd = *on; // SFLEND *END

endif;

enddo;

NBRRECS = SF1NUM;

if NBRRECS = 0;

clear SFL1;

SF1NUM += 1;

write SFL1;

endif;

end-proc;

Now I call the program to display all the Message 1 rows:

CALL PGM(w03a00) PARM(‘0001’)

That’s it!