The RPGIV for the Subfile Image program
//***************************************************************
// ___ _ _ __ __ _ _ *
// | . > ___ ___ _| |_ | |_ | \ \ ___ _ _ _| |_ <_>._ _ *
// | . \/ . \/ . \ | | | . | | |<_> || '_> | | | || ' | *
// |___/\___/\___/ |_| |_|_| |_|_|_|<___||_| |_| |_||_|_| *
// *
// A program to show a subfile that can link to images. *
// *
// *
// *
// 10/2010 booth@martinvt.com *
//***************************************************************
// COMMENTS This program uses MOUBTN() to click F8 to pick *
// a subfile line for linking to an image. *
// It uses the PC Client's file extension default *
// to open the image. *
// *
// (I suppose it could open any file. I know if *
// one uses a filename of "NOTEPAD" then *
// NOTEPAD.EXE opens with a blank panel.) *
// *
// Note: This program uses STRPCCMD. STRPCCMD uses a command *
// parm of 123 characters. This is normally a problem *
// but solving it is not part of this demo. *
// -= be warned =- *
// *
//--------------------------------------------------------------*
H COPYRIGHT('Booth Martin, All rights reserved.')
H option(*nodebugio) dftactgrp(*no) actgrp(*new)
FSFLIMAGED cf e workstn sfile(SFL1 : SF1NUM)
FSFLIMAGEP if e disk
D STRPCOflag s n
D wNdx s 10i 0
D QCMDEXC PR ExtPgm('QCMDEXC')
D wCommand 32702A const options(*varsize)
D wLength 15P 5 const
D wCmd s 1000 varying
//====================================================================*
// MAINLINE-BEGIN *
//====================================================================*
/FREE
exsr S1Fill;
// Display screen.
exsr S1Main;
// Exit.
exsr ExitPgm;
//====================================================================*
// MAINLINE-END *
//====================================================================*
//-------------------------------* Sub-Routine *
// *inzsr() *---------------*
// Initializing sub routine *
//-----------------------------------------------*
begsr *inzsr;
endsr;
//-------------------------------* Sub-Routine *
// ExitPgm() *---------------*
// end of processing *
//-----------------------------------------------*
begsr ExitPgm;
*inlr = *on;
return;
endsr;
//-------------------------------* Sub-Routine *
// S1Main() *---------------*
// Screen - Main processing. *
//-----------------------------------------------*
begsr S1Main;
// Loop until exit.
dow *inkc = *off;
// Display screen.
write S1CMD;
exfmt S1;
select;
// F3=Exit.
when *inkc = *on;
// F8 on either by key or by mouseclick, and on a subfile line.
when *inkh and SF1PICKED > 0;
exsr SFL1Link;
endsl;
enddo;
endsr;
//-------------------------------* Sub-Routine *
// SFL1Link() *---------------*
// Link to the images. *
//-----------------------------------------------*
begsr SFL1Link;
// Start PC Organizer if not started.
if STRPCOflag = *off;
wCmd = 'STRPCO PCTA(*NO)';
callp(e) QCmdExc(wCmd: %len(wCmd) );
STRPCOflag = *on;
endif;
chain SF1PICKED SFL1;
if HAVEFILE = '*';
wCmd =
'STRPCCMD PCCMD('
+ '''rundll32 shell32,ShellExec_RunDLL '
+ %trim(SERVERLOC) + %trim(FILENAME)
+ ''') PAUSE(*NO)';
QCmdExc(wCmd: %len(wCmd) );
else;
// do whatever you want to when there is no hit.
endif;
endsr;
//-------------------------------* Sub-Routine *
// S1Fill() *---------------*
// Screen - Fill screen. *
//-----------------------------------------------*
begsr S1Fill;
// Clear subfile.
*in50 = *on;
write S1;
*in50 = *off;
// Fill SFL.
SF1NUM = *zero;
// Fill the subfile.
// Read the file.
setll *start SFLIMAGEP;
read(e) SFLIMAGEP;
dow %eof = *off;
SF1NUM = SF1NUM + 1;
if SERVERLOC <> *blanks or FILENAME <> *blanks;
HAVEFILE = '*';
*in31 = *on;
else;
HAVEFILE = *blanks;
*in31 = *off;
endif;
write(e) SFL1;
read(e) SFLIMAGEP;
enddo;
// No records?
if SF1NUM = *zero;
SF1NUM = 1;
DESCRIPT = 'No records in file';
write(e) SFL1;
endif;
// Save values.
SF1RECS = SF1NUM;
SF1TOP = 1;
endsr;
|
The DDS for the Screen
****************************************************************
* ___ _ _ __ __ _ _ *
* | . > ___ ___ _| |_ | |_ | \ \ ___ _ _ _| |_ <_>._ _ *
* | . \/ . \/ . \ | | | . | | |<_> || '_> | | | || ' | *
* |___/\___/\___/ |_| |_|_| |_|_|_|<___||_| |_| |_||_|_| *
* *
* A program to show a subfile with abilty to *
* display images. *
* *
* *
* 10/2010 booth@martinvt.com *
****************************************************************
DSPSIZ(24 80 *DS3)
REF(*LIBL/SFLIMAGEP)
PRINT
ERRSFL
CA03
MOUBTN(*ULD CF08)
*****************************************************************
R SFL1 SFL
PRODUCTID R O 9 2
HAVEFILE 1 B + 1DSPATR(PR UL)
N31 DSPATR(ND)
DESCRIPT R O + 1
SERVERLOC R H
FILENAME R H
*****************************************************************
R S1 SFLCTL(SFL1)
SFLPAG(0011)
SFLSIZ(&SF1RECS)
OVERLAY
N50 SFLDSP
N50 SFLDSPCTL
N50 SFLEND(*SCRBAR *MORE)
50 SFLCLR
SFLCSRRRN(&SF1PICKED)
RTNCSRLOC(&PM_RCD &PM_FLD)
PM_RCD 10A H
PM_FLD 10A H
SF1NUM 4S 0H
SF1RECS 5S 0P
SF1PICKED 5S 0H
SF1TOP 4S 0H SFLRCDNBR(CURSOR *TOP)
1 3' _____ __ _____ __ -
____ '
COLOR(TRQ)
2 2' / ___/__ __/ /_ / __(_) /__ -
/ _/___ ___ ____ _____ ____ '
COLOR(TRQ)
3 2' \__ \/ / / / __ \/ /_/ / / _ \ -
/ // __ `__ \/ __ `/ __ `/ _ \'
COLOR(TRQ)
4 2' ___/ / /_/ / /_/ / __/ / / __/ -
_/ // / / / / / /_/ / /_/ / __/'
COLOR(TRQ)
5 2'/____/\__,_/_.___/_/ /_/_/\___/ /-
___/_/ /_/ /_/\__,_/\__, /\___/ '
COLOR(TRQ)
6 2' -
/____/ '
COLOR(TRQ)
1 69DATE
EDTCDE(Y)
2 69TIME
3 69'system i'
4 69USER
8 2'Product ID '
DSPATR(UL)
+ 1'*'
DSPATR(UL)
+ 1'Description'
DSPATR(UL)
*****************************************************************
R S1CMD
22 2' -
-
'
DSPATR(UL)
COLOR(BLU)
23 3'F3=Exit'
COLOR(BLU)
+ 3'F8=Show Image'
COLOR(BLU)
23 60'"*"=Image Available'
COLOR(BLU)
|
The DDS for the Data File
****************************************************************
* ___ _ _ __ __ _ _ *
* | . > ___ ___ _| |_ | |_ | \ \ ___ _ _ _| |_ <_>._ _ *
* | . \/ . \/ . \ | | | . | | |<_> || '_> | | | || ' | *
* |___/\___/\___/ |_| |_|_| |_|_|_|<___||_| |_| |_||_|_| *
* *
* A file for the subfile image demo program. *
* *
* 10/2010 booth@martinvt.com *
****************************************************************
R RSFLIMAGEP
PRODUCTID 15
DESCRIPT 30
SERVERLOC 70
FILENAME 70
|
The RPG (not free form) for the program
****************************************************************
* ___ _ _ __ __ _ _ *
* | . > ___ ___ _| |_ | |_ | \ \ ___ _ _ _| |_ <_>._ _ *
* | . \/ . \/ . \ | | | . | | |<_> || '_> | | | || ' | *
* |___/\___/\___/ |_| |_|_| |_|_|_|<___||_| |_| |_||_|_| *
* *
* A program to show a subfile that can link to images. *
* *
* *
* *
* 10/2010 booth@martinvt.com *
****************************************************************
* COMMENTS This program uses MOUBTN() to click F8 to pick *
* a subfile line for linking to an image. *
* It uses the PC Client's file extension default *
* to open the image. *
* *
* (I suppose it could open any file. I know if *
* one uses a filename of "NOTEPAD" then *
* NOTEPAD.EXE opens with a blank panel.) *
* *
* Note: This program uses STRPCCMD. STRPCCMD uses a command *
* parm of 132 characters. This is normally a problem *
* but solving it is not part of this demo. *
* -= be warned =- *
* *
*--------------------------------------------------------------*
H COPYRIGHT('Booth Martin, All rights reserved.')
H option(*nodebugio) dftactgrp(*no) actgrp(*new)
FSFLIMAGED cf e workstn sfile(SFL1 : SF1NUM)
FSFLIMAGEP if e disk
D STRPCOflag s n
D wNdx s 10i 0
D QCMDEXC PR ExtPgm('QCMDEXC')
D wCommand 32702A const options(*varsize)
D wLength 15P 5 const
D wCmd s 1000 varying
*====================================================================*
* MAINLINE-BEGIN *
*====================================================================*
C exsr S1Fill
* Display screen.
C exsr S1Main
* Exit.
C exsr ExitPgm
*====================================================================*
* MAINLINE-END *
*====================================================================*
*-------------------------------* Sub-Routine *
* *inzsr() *---------------*
* Initializing sub routine *
*-----------------------------------------------*
C *inzsr begsr
C endsr
*-------------------------------* Sub-Routine *
* ExitPgm() *---------------*
* end of processing *
*-----------------------------------------------*
C ExitPgm begsr
C eval *inlr = *on
C return
C endsr
*-------------------------------* Sub-Routine *
* S1Main() *---------------*
* Screen - Main processing. *
*-----------------------------------------------*
C S1Main begsr
* Loop until exit.
C dow *inkc = *off
* Display screen.
C write S1CMD
C exfmt S1
C select
* F3=Exit.
C when *inkc = *on
* F8 on either by key or by mouseclick, and on a subfile line.
C when *inkh and SF1PICKED > 0
C exsr SFL1Link
C endsl
C enddo
C endsr
*-------------------------------* Sub-Routine *
* SFL1Link() *---------------*
* Link to the images. *
*-----------------------------------------------*
C SFL1Link begsr
* Start PC Organizer if not started.
C if STRPCOflag = *off
C eval wCmd = 'STRPCO PCTA(*NO)'
C callp(e) QCmdExc(wCmd: %len(wCmd) )
C eval STRPCOflag = *on
C endif
C SF1PICKED chain SFL1
C if HAVEFILE = '*'
C eval wCmd =
C 'STRPCCMD PCCMD('
C + '''rundll32 shell32,ShellExec_RunDLL '
C + %trim(SERVERLOC) + %trim(FILENAME)
C + ''') PAUSE(*NO)'
C callp QCmdExc(wCmd: %len(wCmd) )
C else
* do whatever you want to when there is no hit.
C endif
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
* Fill the subfile.
* Read the file.
C *start setll SFLIMAGEP
C read(e) SFLIMAGEP
C dow %eof = *off
C eval SF1NUM = SF1NUM + 1
C if SERVERLOC <> *blanks or FILENAME <> *blanks
C eval HAVEFILE = '*'
C eval *in31 = *on
C else
C eval HAVEFILE = *blanks
C eval *in31 = *off
C endif
C write(e) SFL1
C read(e) SFLIMAGEP
C enddo
* No records?
C if SF1NUM = *zero
C eval SF1NUM = 1
C eval DESCRIPT = 'No records in file'
C write(e) SFL1
C endif
* Save values.
C eval SF1RECS = SF1NUM
C eval SF1TOP = 1
C endsr
|
|
|
