|
Larry and Tim, > Before I start writing my own version of RtvFldLoc() I need to ask - are you > willing to share your code? No problem at all. Just realized it's a little bit longer. I hope David don't mind. BTW, there used to be a bug ( "lock level" ) with this API that was fixed in V4R3. PTFs for reducing the lock level are V3R2-SF45915, V3R7-SF45917, V4R1-SF45918, and V4R2-SF45921. *---------------------------------------------------------------* * Retrieve field location * *---------------------------------------------------------------* P RtvFldLoc B Export D Pi Like( LglTyp ) D QDspFil Like( QNamTyp ) Value D RcdFmt Like( NamTyp ) Value D FldNam Like( NamTyp ) Value D Row 3P 0 D Col 3P 0 D RcvVar S Like( BufTyp ) D RcvVarLen S Like( IntTyp ) D Inz( %Size( RcvVar ) ) D Idx S Like( IntTyp ) D SDFFINFO S Like( IntTyp ) D LDFARFTE S Like( IntTyp ) D SDFARFTE S Like( IntTyp ) D SDFFRDPD S Like( IntTyp ) D SDFFRCTE S Like( IntTyp ) D SDFFXRDP S Like( IntTyp ) D SDFFRINF S Like( IntTyp ) D SDFFNTB S Like( IntTyp ) D True C *On D False C *Off D FMTAR S 16 Dim( 999 ) D FMTNM S 10 Dim( 999 ) D FLDNM S 10 Dim( 999 ) D FLDRC S 2 Dim( 999 ) D Ds D RC12 Like( SmlIntTyp ) D RC1 Like( ChrTyp ) D Overlay( RC12:1 ) D RC2 Like( ChrTyp ) D Overlay( RC12:2 ) * Base file section ( QDFFBASE ) DQDFFBASE Ds D QDFFRETN 1 4B 0 D QDFFSIZE 5 8B 0 D QDFFINOF 9 10B 0 D QDFFRCS 11 12B 0 D QDFBITS 13 13 D QDFFFSCR 14 15B 0 D QDFFSRSQ 16 17B 0 D QDFCCSID 18 19B 0 D QDFFSCRS 20 20 * File header section ( QDFFINFO ) DQDFFINFO Ds D QDFFDFLO 1 4B 0 D QDFFWUOF 5 8B 0 D QDFFFMWU 9 12B 0 D QDFFSEQO 13 16B 0 D QDFFFSFL 17 18B 0 D QDFFFSCE 19 20B 0 D QDFBITS01 21 22 D QDFRVED7 23 34 D QDFFXDOF 35 36B 0 * Record format table ( QDFARFTE ) DQDFARFTE Ds D QDFARFNM 1 10 D QDFBITS08 11 12 D QDFARFOF 13 16B 0 * Record header section ( QDFFRINF ) DQDFFRINF Ds D QDFFRDDO 1 4B 0 D QDFFOFIT 5 8B 0 D QDFFSTBO 9 12B 0 D QDFBITS09 13 16 D QDFFFLD 17 18B 0 D QDFVED21 19 22 D QDFFINDO 23 24B 0 D QDFVED22 25 28 D QDFFRAOF 29 30B 0 * Display-Record-Level-Device-Dependent section ( QDFFRDPD ) DQDFFRDPD Ds D QDFFDRCO 1 4B 0 D QDFFINCP 5 6B 0 D QDFFFIBF 7 8B 0 D QDFFFOIS 9 10B 0 D QDFVED23 11 12 D QDFBITS11 14 14 D QDFBITS12 15 15 D QDFBITS13 16 16 D QDFBITS14 17 18 D QDFBITS15 19 20 D QDFFERRM 21 22B 0 D QDFBITS16 23 23 D QDFBITS17 24 24 D QDFFCGRI 25 26B 0 D QDFBITS18 27 28 D QDFFXRDO 29 30B 0 D QDFVED32 31 32 D QDFFRDOC 33 34B 0 * Display-Record-Level-Device-Dependent section * extension structure ( QDFFXRDP ) DQDFFXRDP Ds D QDFFFOTO 1 4B 0 D QDFFNRCO 5 8B 0 D QDFVED33 9 12 D QDFFSEGS 13 14B 0 D QDFVED34 15 16 D QDFHCTLO 17 18B 0 D QDFVED35 19 24 * Row-Column table entry ( QDFFRCTE ) DQDFFRCTE Ds D QDFFSROW 1 1 D QDFFSCOL 2 2 C Eval Row = 0 C Eval Col = 0 * Retrieve display file description ( QDFRTVFD ) API C Call 'QDFRTVFD' C Parm RcvVar C Parm RcvVarLen C Parm 'DSPF0100' Format 8 C Parm QDspFil C Parm ApiErrDs C If ApiErrLen > 0 C Return *Off C EndIf C Eval QDFFBASE = %SUBST( RcvVar:1:20 ) C Eval SDFFINFO = QDFFINOF + 1 C Eval QDFFINFO = %SUBST( RcvVar:SDFFINFO:36 ) C Eval SDFARFTE = SDFFINFO + QDFFDFLO C Eval LDFARFTE = QDFFRCS * 16 C Eval FMTAR = *Blank C Eval Idx = 1 C DoW Idx <= QDFFRCS C Eval FMTAR( Idx ) = %SUBST(RcvVar:SDFARFTE:16) C Eval FMTNM( Idx ) = %SUBST(RcvVar:SDFARFTE:10) C Eval Idx = Idx + 1 C Eval SDFARFTE = SDFARFTE + 16 C EndDo C Eval Idx = 1 C RcdFmt LookUp FmtNm( Idx ) 10 C If *In10 = True C MoveA FmtAr( Idx ) QDFARFTE C Eval SDFFRINF = SDFFINFO + QDFARFOF C Eval QDFFRINF = %SUBST( RcvVar:SDFFRINF:30 ) C Eval SDFFRDPD = SDFFRINF + QDFFRAOF C Eval QDFFRDPD = %SUBST( RcvVar:SDFFRDPD:34 ) C Eval SDFFRCTE = SDFFRINF + QDFFDRCO + 6 C Eval SDFFXRDP = SDFFRINF + QDFFXRDO C Eval QDFFXRDP = %SUBST( RcvVar:SDFFXRDP:24 ) C Eval SDFFNTB = SDFFRINF + QDFFNRCO C Eval FldNm = *Blank C Eval FldRC = *Blank C Eval Idx = 1 C DoW Idx <= QDFFFLD C Eval FLDNM( Idx ) = %SUBST( RcvVar:SDFFNTB:10) C Eval FLDRC( Idx ) = %SUBST( RcvVar:SDFFRCTE:2) C Eval Idx = Idx + 1 C Eval SDFFNTB = SDFFNTB + 10 C Eval SDFFRCTE = SDFFRCTE + 2 C EndDo C Eval Idx = 1 C FldNam LookUp FldNm( Idx ) 11 C If *In11 = True C Eval RC1 = X'00' C MoveA FldRC( Idx ) QDFFRCTE C Move QDFFSROW RC2 C Z-Add RC12 Row C Move QDFFSCOL RC2 C Z-Add RC12 Col C Eval Col = Col + 1 C If Col > 80 C Eval Col = Col - 80 C Eval Row = Row + 1 C EndIf C EndIf C EndIf C Return *On P RtvFldLoc E Regards, Frank Jodat +--- | This is the RPG/400 Mailing List! | To submit a new message, send your mail to RPG400-L@midrange.com. | To subscribe to this list send email to RPG400-L-SUB@midrange.com. | To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: david@midrange.com +---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
