|
Frank:
Thanks for sharing this. Must be something missing though (some "/COPY"s?) because your LIKE()'s reference variables which aren't declared anywhere.
Dave
-----Original Message-----
From: Frank Jodat [mailto:jodat@Dakosy.DE]
Sent: Saturday, November 06, 1999 8:21 AM
To: RPG400-L@midrange.com
Subject: Re: Cursor positioning
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
