|
The Physical x-ref file
****************************************************************
* PROGRAMMER - Booth Martin *
* DATE - 3/03 *
* COMMENTS - A Physical File For IMAGES *
* *
****************************************************************
A R RUTLIMAGES
A UTLPART# 30 COLHDG('Part #')
A UTLPICPATH 255 COLHDG('Picture Path')
* SEQUENCE BY Part #
A K UTLPART#
|
Create the data queue, start the viewer:
*
* create the dataq and open the image screen.
*
* "sds" is the whole System Data Structure /QDDSSRC/SDS.
D SDS
DUSRPRF 254 263
* variables that contain the dataq name used for client
D qnameo s 10
* The name of the image viewer program that will read the data queue
D VARPGProg C 'C:\WDT400\test\IMAGE.EXE'
* _________________________________________________________________
C eval qnameO= 'IM' + %SubSt(UsrPrf:1:8)
* Create data queues
C Eval Tmpxx= 'CRTDTAQ DTAQ(QGPL/'
C + %Trim(qNameO) + ') MAXLEN(30)'
C Call (E) 'QCMDEXC'
C Parm Tmpxx 1024
C Parm 1024 parm15 15 5
* If there is an error, do no more. The most likely error is
* that the data que already exists, which is just fine.
C If %Error
C Else
* Start the VARPG Program:
C Eval Tmpxx= 'STRPCO PCTA(*NO)'
C Call (E) 'QCMDEXC'
C Parm Tmpxx
C Parm 1024 parm15
C Eval Tmpxx= 'STRPCCMD PCCMD('''
C + %Trim(VARPGProg) + ' '
C + %Trim(qNameO)
C + ''') PAUSE(*NO)'
C Call (E) 'QCMDEXC'
C Parm Tmpxx
C Parm 1024 parm15
C EndIf
* Initialization is done, now do event processing
C Eval *INLR = *On
* _________________________________________________________________
|
The code needed in any program to call the image viewer
* send the part # on the data q
*
* Special note of thanks to Roger Anderson
* University Development Information Systems
* University of Illinois
* for showing how to do the Prototyped call.
FUTLIMGD CF E WORKSTN SFILE(SFLA:RRNA)
FUTLIMages IF E K Disk
*
D SDS
DUSRPRF 254 263
* Definitions:
D QName S 10
D LibName S 10 Inz('QGPL')
D msg_sz S 5 0 Inz(30)
* dataq info
D Qsnddtaq PR extpgm('QSNDDTAQ')
D aaa Like(QName)
D bbb Like(LibName)
D ccc Like(msg_sz)
D ddd Like(UtlPart#)
* _________________________________________________________________
C DoU *INLR
C Exsr FillSubFileSR
C WRITE FOOTER
C EXFMT FMT01
C Read (E) Footer
* Select options:
C Select
* F5 = Refresh
C When *INKE
C Exsr FillSubFileSR
* F3 or F12 Exit
C When *INKL Or *INKC
C MOVE *ON *INLR
* If not one of the above, then ....
C Other
* Any changes?
C ReadC (E)SFLA
C Dow Not %EOF
C Select
C When Opt <> ' '
C Exsr SENDPART#SR
C Eval Opt = ' '
C Update SFLA
C ReadC (E) SFLA
C EndSl
C EndDo
C EndSl
C EndDo
* ________________________________________________________________
*
C FillSubFileSR begsr
* Clear subfile & screen, prepare to re-fill or fill:
C Eval *IN45=*Off
C Eval *IN90=*Off
C Clear SFLA
C Write FMT01
C Eval *IN90=*On
* Fill the subfile, if something there:
C Z-ADD 0 RRNA 5 0
C Z-ADD 0 RRN 4 0
C *LoVal Setll UtlImages
C Read (E) UtlImages
C If %EOF
C ADD 1 RRN
C Z-add RRN RRNA
C Z-add 1 NbrRec
* fill a line
C WRITE (E) SFLA
C Else
* Fill the subfile:
C DOU %EOF
C ADD 1 RRN
C Z-add RRN RRNA
* fill the detail fields:
C WRITE (E) SFLA
C READ (E) UtlIMAGES
C END
C Z-add RRN NbrRec
C END
C Eval *IN91 = *Off
C IF RRN > 6
C MOVE *ON *IN91
C END
C EndSR
* _________________________________________________________________
*
C SENDPART#SR begsr
* Send Part# data queue
C callP (E) QSNDDTAQ(QName:LibName:MSG_SZ:UtlPart#)
* If an error that most likely means the VARPG window was closed. Reopen it.
C If %Error
C eval qname = 'IM' + %SubSt(UsrPrf:1:8)
C Call (E) 'IMGDTQSTR'
C callP (E) QSNDDTAQ(QName:LibName:MSG_SZ:UtlPart#)
C endIf
C EndSR
* _________________________________________________________________
* Initialization subroutine used to setup the server environment
C *inzsr begsr
C eval qname = 'IM' + %SubSt(UsrPrf:1:8)
C Call (E) 'IMGDTQSTR'
C endsr
* == ================================================================
|
DDS to create a subfile program for testing
A*%%TS SD 20030322 023110 BOOTHM REL-V5R1M0 5722-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A ERRSFL
A PRINT
A CF03
A CF05
A CF12
A R SFLA SFL
A*%%TS SD 20030322 013642 BOOTHM REL-V5R1M0 5722-WDS
A OPT 1A B 12 2
A UTLPART# R O 12 4
A R FMT01 SFLCTL(SFLA)
A*%%TS SD 20030322 023110 BOOTHM REL-V5R1M0 5722-WDS
A SFLPAG(0008)
A SFLSIZ(&NBRREC)
A RTNDTA
A OVERLAY
A 90 SFLDSP
A 90 SFLDSPCTL
A N90 SFLCLR
A 91 SFLEND(*SCRBAR *MORE)
A 11 1'Opt -
A -
A '
A DSPATR(UL)
A COLOR(BLU)
A NBRREC 5S 0P
A 1 3' _ __ _ _ -
A ___ -
A | | / /(_)___ _ __ -
A (_)__ _ ___ _ ___ _ ___ ___ / -
A _/____ ___ __ _ | |/ // // -_)-
A | |/|/ / / // '' \/ _ `// _ `// --
A _)(_-< / _// __// _ \ / '' \ |_-
A __//_/ \__/ |__,__/ /_//_/_/_/\_,_-
A / \_, / \__//___/ /_/ /_/ \___//_-
A /_/_/ -
A /___/ -
A ___ _ ___ _ _-
A ___ ___ ___ ___ ___ ____ ____ -
A ___ ___ ___ / _ `-
A / / _ `// __// -_)/ -_)/ _ \ (_- /-
A __// __// -_)/ -_)/ _ \ -
A \_,_/ \_, //_/ \__/ \__//_/-
A /_/ /___/\__//_/ \__/ \__//_//_/ -
A /___/ -
A -
A '
A COLOR(BLU)
A R FOOTER
A*%%TS SD 20030322 013642 BOOTHM REL-V5R1M0 5722-WDS
A 23 3' F3=Exit -
A F5=Refresh F12-
A =Cancel'
A COLOR(BLU)
A 22 3'D=Delete -
A -
A '
A COLOR(BLU)
A 21 2' -
A -
A '
A DSPATR(UL)
A COLOR(BLU)
|
RPG to create a subfile program for testing
* send the part # on the data queue
FUTLIMGD CF E WORKSTN SFILE(SFLA:RRNA)
FUTLIMages IF E K Disk
* "sds" is the whole System Data Structure /QDDSSRC/SDS.
D SDS
DUSRPRF 254 263
* variables that contain the dataq name used for client
D qnameo s 10
D* parameters for dataq API's
D msg_sz s 5 0
D Name_of_Lb s 10
* _________________________________________________________________
C DoU *INLR
C Exsr FillSubFileSR
C WRITE FOOTER
C EXFMT FMT01
C Read (E) Footer
* Select options:
C Select
* F5 = Refresh
C When *INKE
C Exsr FillSubFileSR
* F3 or F12 Exit
C When *INKL Or *INKC
C MOVE *ON *INLR
* If not one of the above, then ....
C Other
* Any changes?
C ReadC (E)SFLA
C Dow Not %EOF
C Select
C When Opt <> ' '
C Exsr SENDPART#SR
C Eval Opt = ' '
C Update SFLA
C ReadC (E) SFLA
C EndSl
C EndDo
C EndSl
C EndDo
* _______________________________________________________________
*
C FillSubFileSR begsr
* Clear subfile & screen, prepare to re-fill or fill:
C Eval *IN45=*Off
C Eval *IN90=*Off
C Clear SFLA
C Write FMT01
C Eval *IN90=*On
* Fill the subfile, if something there:
C Z-ADD 0 RRNA 5 0
C Z-ADD 0 RRN 4 0
C *LoVal Setll UtlImages
C Read (E) UtlImages
C If %EOF
C ADD 1 RRN
C Z-add RRN RRNA
C Z-add 1 NbrRec
* fill a line
C WRITE (E) SFLA
C Else
* Fill the subfile:
C DOU %EOF
C ADD 1 RRN
C Z-add RRN RRNA
* fill the detail fields:
C WRITE (E) SFLA
C READ (E) UtlIMAGES
C END
C Z-add RRN NbrRec
C END
C Eval *IN91 = *Off
C IF RRN > 6
C MOVE *ON *IN91
C END
C EndSR
* _________________________________________________________________
*
C SENDPART#SR begsr
* Send Part# data queue
C call (E) 'QSNDDTAQ'
C parm qnameo
C parm 'QGPL ' NAME_OF_LB
C parm 30 MSG_SZ
C parm UTLPART# 30
C If %Error
C Call (E) 'IMGDTQSTR'
C endIf
C EndSR
* _________________________________________________________________
* Initialization subroutine used to setup the server environment
C *inzsr begsr
C eval qnameO= 'IM' + %SubSt(UsrPrf:1:8)
C Call (E) 'IMGDTQSTR'
C endsr
* _________________________________________________________________
|
The pieces of code you'll need to insert in the programs that show images
* Special note of thanks to Roger Anderson
* University Development Information Systems
* University of Illinois
* for the help with the Prototyped call.
D SDS
DUSRPRF 254 263
* Definitions:
D QName S 10
D LibName S 10 Inz('QGPL')
D msg_sz S 5 0 Inz(30)
* dataq info
D Qsnddtaq PR extpgm('QSNDDTAQ')
D aaa Like(QName)
D bbb Like(LibName)
D ccc Like(msg_sz)
D ddd Like(UtlPart#)
* _________________________________________________________________
*
C SENDPART#SR begsr
* Send Part# data queue
C callP (E) QSNDDTAQ(QName:LibName:MSG_SZ:UtlPart#)
* If an error that most likely means the VARPG window was closed. Reopen it.
C If %Error
C eval qname = 'IM' + %SubSt(UsrPrf:1:8)
C Call (E) 'IMGDTQSTR'
C callP (E) QSNDDTAQ(QName:LibName:MSG_SZ:UtlPart#)
C endIf
C EndSR
* _________________________________________________________________
* Initialization subroutine used to setup the server environment
C *inzsr begsr
C eval qname = 'IM' + %SubSt(UsrPrf:1:8)
C Call (E) 'IMGDTQSTR'
C endsr
* _________________________________________________________________
|
The Visual Age RPGIV for the image viewer
*-------------------------------------------------------------------=
* Show images for part numbers, allow adding/updating: =
*-------------------------------------------------------------------=
FUtlImages UF A E K Disk Remote
* "sds" is the whole System Data Structure /QDDSSRC/SDS.
D SDS
DPARMS# 37 39S 0
D UtlPart#In S 30
* data queue so job can run until the calling program ends
* library name for dataq and data size to be get and wait time
D Name_of_LB s 10
D msg_sz S 5 0
D wait_time s 5 0
* name of dataq passed from Server
D qnameo s 10
D QRCVDTAQ s 10 inz('QRCVDTAQ')
D linkage(*server)
D QCMDEXC C 'QCMDDDM' Linkage(*Server)
*-------------------------------------------------------------------=
* If the window closes in some other way than the Exit button. =
*-------------------------------------------------------------------=
C MAIN BEGACT DESTROY MAIN
C Exsr LastRecordSR
C ENDACT
*-------------------------------------------------------------------=
* Exit pushbutton pushed =
*-------------------------------------------------------------------=
C EXIT BEGACT PRESS MAIN
C Exsr LastRecordSR
C ENDACT
*-------------------------------------------------------------------=
* Last Record SR =
*-------------------------------------------------------------------=
C LastRecordSR BEGSR
* When client app ends, clean up server environment
C If Parms# > 0
*
* Delete data queue
C Eval Tmpxx= 'DLTDTAQ DTAQ(QGPL/'
C + %Trim(Qnameo) + ')'
C Call (E) QCMDEXC
C Parm Tmpxx 1024
C Parm 1024 parm15 15 5
C EndIf
C MOVE *ON *INLR
C ENDSR
*-------------------------------------------------------------------=
* Heading image: =
*-------------------------------------------------------------------=
C PSBIMAGE1 BEGACT PRESS MAIN
C EVAL %SETATR('*component':'*component':
C 'dialog') = 1
C EVAL %SETATR('*component':'*component':
C 'filename') = utlpicpath
*
C EVAL utlpicpath=%GETATR('*component':'*component'
C :'filename')
C Eval %SetAtr('MAIN':'utlpicpath':'Text') =
C utlpicpath
C ENDACT
*-------------------------------------------------------------------=
* If Image name changes, change the displayed image =
*-------------------------------------------------------------------=
C UTLPICPATH BEGACT CHANGE MAIN
C EVAL %SETATR('MAIN':'ImageFrame':'FileName')
C = %Trim(%GetAtr('Main':'utlpicpath':'Text'))
C Eval %SetAtr('Main':'Main':'Focus')=1
C ENDACT
*-------------------------------------------------------------------=
* Save the info: add or update: =
*-------------------------------------------------------------------=
C PSB0000209 BEGACT PRESS MAIN
C Read (E) 'Main'
C If UtlPart# > *Blanks
C UtlPart# Chain (E) UtlImages
C If %Found
C Update (E)RUtlImages
C Else
C Write (E) RUtlImages
C EndIf
C EndIf
C If %Error
C *Msg0001 Dsply RC 9 0
C EndIf
C ENDACT
*-------------------------------------------------------------------=
* =
*-------------------------------------------------------------------=
C *INZSR BEGSR
C* Beginning of mainline
C *entry plist
C parm qnameo
C ENDSR
*-------------------------------------------------------------------=
* Timer event: =
*-------------------------------------------------------------------=
C TIM000020A BEGACT TICK MAIN
C Eval %SetAtr('Main':'TIM000020A':'Visible')=1
C call QRCVDTAQ
C parm qnameo
C parm 'QGPL ' NAME_OF_LB
C parm 30 MSG_SZ
C parm *Blanks UtlPart#In
C parm .5 WAIT_TIME
C If UtlPart#In > *blanks
C And UtlPart#In <> UtlPart#
C UtlPart#In Chain (E) UtlImages
C If %Found
C Else
C Eval UtlPart# = UtlPart#In
C Eval UtlPicpath = *Blanks
C EndIf
C Write (E)'Main'
C endif
C Eval %SetAtr('Main':'TIM000020A':'Visible')=0
C ENDACT
*-------------------------------------------------------------------=
* Start the timer if the program is called: =
*-------------------------------------------------------------------=
C TIM000020A BEGACT CREATE MAIN
C If Parms# > 0
C Eval %SetAtr('Main':'Tim000020A':'TimerMode') = 1
C EndIf
C ENDACT
*-------------------------------------------------------------------=
|
|
|
| |
