|
|
The RPG to center text in a field
* ....................................................
* : This program shows a method for :
* : centering text in a field :
* : :
* : 4/98 Booth M. :
* : :
* : (Note: this program uses the Opcode CHEKR. :
* : Originally the program did a loop, starting at :
* : the high number and decrementing column by :
* : column until a not-blank was encountered. :
* : CHEKR does this as an Opcode. Thanks to :
* : Mark Westphal for pointing this out to me.) :
* : Mark Westfall vtas400@together.net :
* : :
* ::::::::::::::::::::::::::::::::::::::::::::::::::::
FCENTERFM CF E WORKSTN
D CF S 1 DIM(30)
D TmStamp S Z inz
C* ..................................................
C Time TmStamp
C MOVEl TmStamp FIELD20 20 0
c field20 mult .000001 field6 6 0
C MOVEl field6 FIELD
C *INKC DOUEQ *ON
C EXFMT FMT01
C EXSR CHOOSE
C END
C MOVE *ON *INLR
C* ....................................................
C* : S U B R O U T I N E S :
C* ::::::::::::::::::::::::::::::::::::::::::::::::::::
C* Center the typed field.
C CHOOSE BEGSR
C MOVE *OFF *IN41
C MOVE *BLANKS CF
C FIELD IFNE *BLANKS
C* CHEKR reads a field character by character, right to left.
C* Factor 1 is what is being compared too.
C ' ' CHECKR FIELD I 2 0
C* I equals the position in the FIELD of the last non-blank character.
C* The field's length (30) less I equals the number of empty columns.
C* Dividing by 2 is the correct place to place the beginning of FIELD.
C I IFGE 29
C Z-ADD 1 I
C ELSE
C 30 SUB I I
C I DIV 2 I
C* Add one, to move over one space to start with.
C ADD 1 I
C END
C MOVEA FIELD CF(I)
C MOVE *BLANKS FIELD
C MOVEA CF FIELD
C ELSE
C MOVE *ON *IN41
C END
C ENDSR
C*-------------------------------------------------------------------
|
The DDS to center text on a display screen
A*%%TS SD 19980320 010039 BOOTH REL-V3R7M0 5716-PW1
A*%%EC
A DSPSIZ(24 80 *DS3)
A CSRINPONLY
A CHGINPDFT(HI UL LC)
A*
A R FMT01
A*%%TS SD 19980320 010039 BOOTH REL-V3R7M0 5716-PW1
A TEXT('CENTER TEXT')
A CA03(03 'EXIT')
A BLINK
A OVERLAY
A 1 23'Sample of centering a field '
A 1 66'Date:'
A 1 72DATE
A EDTCDE(Y)
A COLOR(WHT)
A 2 4'(FMT01) '
A 2 66'Time:'
A 2 72TIME
A COLOR(WHT)
A 4 29'Center a field:'
A COLOR(WHT)
A 7 8'Text to be centered:'
A FIELD 30A B 7 29
A 16 29'F3=exit'
A 41 8 33'Can''t leave field blank'
A COLOR(RED)
|
Hans Bertol sent an e-mail with a much better solution. Here is Hans' e-mail:
"Hello Martin
I think I have a better solution for the centering of a textstring.
H DEBUG CURSYM('S') DECEDIT('0,')
H COPYRIGHT('(C) ÖAF Gräf & Stift AG Wien 1987, 1997.')
H OPTION(*SRCSTMT:*NODEBUGIO)
H USRPRF(*USER )
H AUT(*USE)
H DATFMT(*EUR)
D Text S 50
D Len S 3 0
D Start S 3 0
D HELP S 50
C *ENTRY PLIST
C PARM Text
C* ** Text linksbündig stellen und danach zentrieren
C EVAL HELP = %TRIM(Text)
C EVAL Text = *BLANK
C EVAL Len = %Len(%Trim(HELP))
C EVAL Start = ((50 - Len) / 2) + 1
C EVAL %SUBST(Text:Start:Len) =%SUBST(HELP:1:Len)
C EVAL *INLR = *ON
mit besten Grüssen/kind regards
Hans Bertol
ÖAF Gräf & Stift AG Wien
Tel +43-1-86631-129
Fax +43-1-86631-109
mailto:Hans_Bertol@mn.man.de "
|
Booth,
I like the site. First time I've seen it. If you don't mind I'm going to
try out a few of your code snippets. Here are a couple string type things
that I have that I see you've written as well. Maybe you can modify them
and they can help sometime? One is procedures and the other just random
tests.
Mike
h nomain
h debug( *yes )
h optimize( *full )
h option( *nodebugio : *srcstmt )
é*****************************************************************
é*¹Procedure Prototypes é*
é*****************************************************************
d #centerText pr 256a
d inString 256a varying
d textLength 3s 0
d #cvtToLower pr 256a
d inString 256a varying
d start@ 3s 0 options( *nopass )
d #cvtToUpper pr 256a
d inString 256a varying
d start@ 3s 0 options( *nopass )
d #standardize pr 1024a
d inString 1024a const
d changeFrom 1024a const
d changeTo 1024a const
é*****************************************************************
é*¹Global Variables é*
é*****************************************************************
d lo c const('abcdefghijklmnopqrstuvwxyz')
d up c const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
é**********************************************************************
é*¹Procedure - #centerText é*
é*¹Description - Center text in a string é*
é*¹Input - textIn 256a - text to be centered é*
é*¹ - fieldLength 3,0 - length of field to center it in é*
é*¹Output - string 256a - make sure to MOVEL or EVAL output é*
é**********************************************************************
p #centerText b export
d #centerText pi 256a
d inString 256a varying
d fldLen 3s 0
d i s 2 0
d textOut s 256a
/free
i = (( fldLen - %len( inString )) / 2 ) + 1;
%subst( textOut : i ) = inString;
return textOut;
/end-free
p #centerText e
/eject
é**********************************************************************
é*¹Procedure - #cvtToLower é*
é*¹Description - Convert a string to lower case letters é*
é*¹Input - string 256a é*
é*¹ - starting position within string *optional* é*
é*¹ the default on nopass will be the first position é*
é*¹Output - string 256a - all lower case é*
é**********************************************************************
p #cvtToLower b export
d #cvtToLower pi 256a
d inString 256a varying
d start@ 3s 0 options( *nopass )
/free
if %parms = 1;
return %xlate( up : lo : inString );
else;
return %xlate( up : lo : inString : start@ );
endif;
/end-free
p #cvtToLower e
/eject
é**********************************************************************
é*¹Procedure - #cvtToUpper é*
é*¹Description - Convert a string to upper case letters é*
é*¹Input - string 256a é*
é*¹ - starting position within string *optional* é*
é*¹ the default on nopass will be the first position é*
é*¹Output - string 256a - all upper case é*
é**********************************************************************
p #cvtToUpper b export
d #cvtToUpper pi 256a
d inString 256a varying
d start@ 3s 0 options( *nopass )
/free
if %parms = 1;
return %xlate( lo : up : inString );
else;
return %xlate( lo : up : inString : start@ );
endif;
/end-free
p #cvtToUpper e
/eject
é**********************************************************************
é*¹Procedure - #standardize é*
é*¹Description - Receive a character string and convert any special é*
é*¹ characters to acceptable characters. é*
é*¹ Note: changeFrom / changeTo strings must be in the é*
é*¹ matching order so that the correct characters é*
é*¹ are changed to their correct conterparts. é*
é*¹Input - inString - string to be manipulated é*
é*¹ - changeFrom - change from this character é*
é*¹ - changeTo - change to this character é*
é*¹Output - outString é*
é**********************************************************************
p #standardize b export
d #standardize pi 1024a
d inString 1024a const
d changeFrom 1024a const
d changeTo 1024a const
/free
return %xlate( changeFrom : changeTo : inString );
/end-free
p #standardize e
|
Here's Mike's other code
é*****************************************************************
é*¹Procedure Prototypes é*
é*****************************************************************
d #centerText pr 256a
d inString 256a varying
d textLength 3s 0
d #cvtToLower pr 256a
d inString 256a varying
d start@ 3s 0 options( *nopass )
d #cvtToUpper pr 256a
d inString 256a varying
d start@ 3s 0 options( *nopass )
d #standardize pr 1024a
d inString 1024a const
d changeFrom 1024a const
d changeTo 1024a const
é**********************************************************************
d testString s 256a varying
d len s 3s 0 inz(80)
d start@ s 3s 0 inz(5)
d numOfTimes s 3s 0
d string s 500a varying
/free
testString = 'Center me in the field please';
testString = #centerText( testString : len );
testString = #cvtToLower( testString );
testString = #cvtToUpper( testString : start@ );
testString = #standardize( '.#.xyz.~' : 'xyz#~' : 'aBc&*' );
return;
/end-free
* scans for '#' and deletes it or replaces it with ''.
c eval numOfTimes = %len( string )
c do numOfTimes
c eval pos = %scan( '#' : string )
c if pos = 0
c leave
c endif
c eval string = %replace( '' : string : pos : 1)
c enddo
|
Code from Graham Smith
* ....................................................
* : This subroutine shows a method :
* : for centering text in a field :
* : :
* : :
* : 12/02 Graham Smith :
* : graham.smith@rookwood-resource.co.uk :
* : :
* ::::::::::::::::::::::::::::::::::::::::::::::::::::
D CentreIO S 256
D OLen S 3 0
*-------------------------------------------------------------------
* Define SourceText & TargetText for for example & compile only
* ------------------------------------------------------------------
D SourceText S 256
D TargetText S 40
* Simply load up inputs to Subroutine and execute it.
C Eval CentreIO = SourceText
C Eval OLen = %Len(TargetText)
C Exsr S_centre
*
* Load centered text to target variable
*
C Eval TargetText = CentreIO
*
*---------------------------------------------------------------------
* Add End program statements for compile purposes only
*
C Eval *inlr = *on
C Return
*---------------------------------------------------------------------
*
C S_centre BEGSR
**********************************************************************
* CentreIO - input text to be centred/Output of Centered text
* OLen - Length of field in which centred text wil appear
**********************************************************************
* Like define work field so only two D specs required for Subr use
*
C *LIKE DEFINE CentreIO CentreWork
*
C Eval CentreWork = *blanks
C If %len(%trim(CentreIO)) < Olen
*
C Eval %subst(CentreWork:
C %int((OLen-%len(%trim(CentreIO)))/2)+1:
C %len(%trim(CentreIO))) = %trim(CentreIO)
*
C Else
C Eval CentreWork = %trim(CentreIO)
C Endif
*
C Eval CentreIO = CentreWork
*
C Endsr
****************** End of data *********************************************
|
|
|
|
| |
