IBMi (AS400) fans only ‘ Subfile window with mouse Selection - DoubleLeftClick - MOUBTN(*ULD CA04)
#IBMiSample
Subfile window with mouse selection - DoubleLeftClick - MOUBTN(*ULD CA04)
Subfile window with mouse selection - DoubleLeftClick - MOUBTN(*ULD CA04)
This example uses DoubleLeftClick MOUBTN(*ULD CA04) to select a subfile row.
Please note:
the mouse works with "Personal Communications iSeries Access" and does not work with a simple 5250 emulator (for example Mocha TN5250 does not detect the mouse). If you don't have "Personal Communications iSeries Access" it doesn't matter, the mouse doesn't work but the function keys work as usual.
First of all look at this post and compile and populate CLANA00F to use this example.
Don't forget to set the screen to 132 columns!
Don't forget to set the screen to 132 columns!
This is the display file:
CL01SFV.DSPF
**************************************************************
* CLANA01L Subfile with select option
**************************************************************
DSPSIZ(27 132 *DS4)
INDARA
CA03(03 'F3=Exit')
REF(CLANA00F)
CHGINPDFT(CS UL HI)
*-------------------------------------------------------------
R SFL1 SFL
*-------------------------------------------------------------
S1OPT 1A B 8 1VALUES(' ' '1')
S1ANN0 R O + 1REFFLD(CLANN0)
S1CCL0 R O +2REFFLD(CLCCL0) EDTCDE(Z)
S1NOM0 R O +1REFFLD(CLNOM0)
*-------------------------------------------------------------
R F01 SFLCTL(SFL1)
*-------------------------------------------------------------
OVERLAY
WINDOW(3 48 19 71)
SFLPAG(0010)
SFLSIZ(&NBRRECS)
N50 SFLDSP
N50 SFLDSPCTL
50 SFLCLR
91 SFLEND(*MORE)
RTNCSRLOC(&PM_RCD &PM_FLD)
SFLCSRRRN(&RRNA)
MOUBTN(*ULD CA04)
CA04(04 'Sel Row')
PM_RCD 10A H
PM_FLD 10A H
SF1NUM 4S 0H
NBRRECS 5S 0P
RRNA 5S 0H
1 28'Customers'
DSPATR(HI)
* Text
F1DESCR 60A O 2 2COLOR(RED)
* Text
F1DESC2 60A O 3 2COLOR(RED)
* Text
F1DESC3 60A O 4 2COLOR(RED)
* Funtion explanation
5 1'1 or Double Click=Select row'
COLOR(BLU)
+02'F3=Exit'
COLOR(BLU)
* Column header
6 3'A'
+ 1'CustCode'
+1'Name'
* Filters
F1ANN0 R B 7 3REFFLD(CLANN0)
F1CCL0 R B +2REFFLD(CLCCL0) EDTCDE(Z)
F1NOM0 R B +1REFFLD(CLNOM0) DSPATR(PC)
CHECK(LC)
R DUMMY
TEXT('Prevents Previous +
SCREEN FROM BEING CLEARED')
ASSUME
5 9' '
This is the SQLRPGLE file:
CL01SF.SQLRPGLE
**FREE
ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no);
dcl-f CL01SFV workstn indds(Dspf) sfile(SFL1 : SF1NUM);
dcl-c MaxSFLrec 9999 ;
dcl-s ReLoadSFL ind inz(*on) ;
dcl-s F1ANN0lke varchar(35) inz('%') ;
dcl-s F1ANN0prv varchar(35) inz(*blanks);
dcl-s wF1CCL0str zoned(07) inz(*zeros);
dcl-s wF1CCL0end zoned(07) inz(*hival);
dcl-s F1CCL0prv zoned(07) inz(*loval);
dcl-s F1NOM0lke varchar(50) inz('%') ;
dcl-s F1NOM0prv varchar(52) inz(*blanks);
// indicators
dcl-ds Dspf qualified ;
Exit ind pos(03) inz(*off);
// LeftClick ind pos(04) inz(*off);
DoubleLeftClick ind pos(04) inz(*off);
SflClr ind pos(50) inz(*off);
SflEnd ind pos(91) inz(*off);
end-ds ;
dcl-ds RecordDs;
CLANN0 char(1);
CLCCL0 zoned(7);
CLNOM0 char(50);
end-ds;
dcl-pi CL01SF extpgm('CL01SF');
ppCCL0 packed(7:0);
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 CLANA00F.CLANN0,
CLANA00F.CLCCL0,
CLANA00F.CLNOM0
from CLANA00F
where CLANN0 like :F1ANN0lke
and CLCCL0 between :wF1CCL0str and :wF1CCL0end
and CLNOM0 like :F1NOM0lke
order by CLNOM0
for read only;
//*********************************************************
// Start working...
//*********************************************************
ReLoadSFL = *on;
dow Dspf.Exit = *off;
if ReLoadSFL;
LoadSFL();
endif;
exfmt F01;
select;
when Dspf.Exit; // F3=Exit
leave;
when Dspf.DoubleLeftClick and RRNA > *zeros; // Row selected
chain RRNA SFL1;
// ... whatever you want to happen when a subfile row is doubleLeftClicked.
ppCCL0 = S1CCL0;
leave;
other; // Read user options
dow 1 = 1;
readc SFL1;
if Not %eof;
if S1OPT = '1';
// call a program or a subroutine
ppCCL0 = S1CCL0;
leave;
endif;
if S1OPT = '2';
// call a program or a subroutine
endif;
S1OPT = '>';
update SFL1;
S1OPT = ' ';
else;
leave;
endif;
enddo;
if S1OPT = '1';
leave;
endif;
endsl;
SetFilters();
enddo;
exec sql close C1;
*inlr = *on;
//*****************************************************************
dcl-proc LoadSFL; // Load subfile
//*****************************************************************
ReLoadSFL = *off;
// Clear subfile
Dspf.SflClr = *on;
write F01;
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;
S1ANN0 = CLANN0;
S1CCL0 = CLCCL0;
S1NOM0 = CLNOM0;
SF1NUM += 1;
write SFL1;
else;
Dspf.SflEnd = *on; // SFLEND *END
endif;
enddo;
NBRRECS = SF1NUM;
//S1MSG = %Editc(NBRRECS:'X') + ' record loaded. No more records +
//to load';
if sqlcode = 0 and NBRRECS >= MaxSFLrec; // MaxSFLrec reached
// S1MSG = %Editc(NBRRECS:'X') + ' records loaded. Use filters field +
// to limit the records to be loaded.';
endif;
if NBRRECS = 0;
clear SFL1;
SF1NUM += 1;
S1ANN0 = '*';
// S1MSG = 'No records loaded';
write SFL1;
endif;
end-proc;
//*****************************************************************
dcl-proc SetFilters; // Set filters filed
//*****************************************************************
if (F1ANN0 <> F1ANN0prv); // char filter
F1ANN0prv = F1ANN0;
F1ANN0lke = '%' + %trim(F1ANN0) + '%';
ReLoadSFL = *on;
endif;
if (F1CCL0 <> F1CCL0prv); // numeric filter need str & end
F1CCL0prv = F1CCL0;
wF1CCL0str = F1CCL0;
wF1CCL0end = F1CCL0;
ReLoadSFL = *on;
endif;
if (F1CCL0 = 0); // numeric filter: if 0 set from 0 to HiVal
F1CCL0prv = F1CCL0;
wF1CCL0str = *zeros;
wF1CCL0end = *HiVal;
endif;
if (F1NOM0 <> F1NOM0prv); // Name
F1NOM0prv = F1NOM0;
F1NOM0lke = '%' + %trim(F1NOM0) + '%';
ReLoadSFL = *on;
endif;
end-proc;
Now try this:
CALL PGM(CL01SF) PARM(X'0000000F')
The Parm value is Packed 7,0,
dcl-pi CL01SF extpgm('CL01SF');
ppCCL0 packed(7:0);
end-pi;
so, give it as 0 packed to the program.
so, give it as 0 packed to the program.
To check the selected value try with this:
CL01SFCL.CLP
PGM
DCL VAR(&PPCCL0) TYPE(*DEC) LEN(7 0)
DCL VAR(&PPCCLS) TYPE(*CHAR) LEN(7)
CALL PGM(CL01SF) PARM(&PPCCL0)
CHGVAR VAR(&PPCCLS) VALUE(&PPCCL0)
SNDUSRMSG MSG(&PPCCLS) MSGTYPE(*INFO)
ENDPGM
Now call the CLP:
call cl01sfcl
Now call the CLP:
call cl01sfcl
Double click a row... I click row 1484 **Renzioli...
That's it.
I appreciate all the comments made on this blog.
Comments
Post a Comment