|
 |
 |
 |
Welcome to Code400.com
|
Okay...We all like to get free stuff..Right?!?
Well thats what we are offering here....Free Stuff
- Free storage for your source code.
- Free access to code
samples. (site search)
- Free place to ask questions or just say what you want.
We are interested in what you have to say.
If you can’t find what your’e looking for on this site....
We will add it.
The small print says: We provide the source code on this site as only
a guide. We do not recommend that anyone run any of the code provided
on this site without first testing it.
If you choose to download source from this site directly onto
your production box without testing....Well, YOU are completely to
blame and we don’t want to hear about it.
Random QuoteIt's so simple to be wise. Just think of something stupid to say and then don't say it.
--Sam Levenson
| |
 |
 |
|
Subprocedure Example(s)
Download Programs/Display in text
Format a Text String
Create a copybook with the input/output parameter(s)
I named this one TITLE_CP
BeforeString is the input parameter
Notice the NEXT to last line in this subprocedure is RETURN
This returns the formatted text back to the calling
program.
* TITLE_CP - Copy Member for procedure to return
* formatted text string.
D TITLE pr 256
D BeforeString 256 value
Then create the subprocedure
h nomain expropts(*resdecpos)
*=========================================================
* PROGRAM - TITLE
* PURPOSE - Convert Char string to TITLE format
* WRITTEN - 01/03/05
* AUTHOR - jamie flanary
*
* PROGRAM DESCRIPTION
* This program will take a string and
* translate it to title format
*
*
* INPUT PARAMETERS
* Description Type Size How Used
* ----------- ---- ---- --------
* BeforeString Char 256 In String
* AfterString Dec 256 Out Formattted string
*
* INDICATOR USAGE
* XX - xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
*=========================================================
*
/copy source,TITLE_CP
*
d Up c CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
d Lo c CONST('abcdefghijklmnopqrstuvwxyz')
*
* Beginning of procedure
*
p TITLE b export
* Procedure interface
d TITLE pi 256
d BeforeString 256 value
*
d AfterString s 256
d Count s 4 0
d CurrentOne s 1
d LastOne s 1
d LenStr s 4 0
*
* After below line of code is processed
* BeforeString = my name is jimmyoctane
* AfterString = My Name Is Jimmyoctane
*
c clear AfterString
*
* Lower case the entire thing
*
c Eval BeforeString =
c %Xlate(Up:Lo:BeforeString)
*
c for count = 1 to %len(%trim(BeforeString))
c eval CurrentOne = %subst(BeforeString:count:1)
*
c select
*
c when count = 1
c eval AfterString = %Trim(
c %Xlate(Lo:Up:%Subst(
c BeforeString:1:1)))
*
*
c when %subst(BeforeString:count:4) = 'mfg ' or
c %subst(BeforeString:count:4) = 'inc ' or
c %subst(BeforeString:count:4) = 'inc.' or
c %subst(BeforeString:count:4) = 'ind ' or
c %subst(BeforeString:count:4) = 'co. ' or
c %subst(BeforeString:count:4) = 'co ' or
c %subst(BeforeString:count:3) = 'dr.' or
c %subst(BeforeString:count:3) = 'dr ' or
c %subst(BeforeString:count:4) = 'llc.' or
c %subst(BeforeString:count:4) = 'llc ' or
c %subst(BeforeString:count:3) = 'il ' or
c %subst(BeforeString:count:3) = 'wi '
*
c eval %subst(AfterString:count:3)=
c %Trim(
c %Xlate(Lo:Up:%Subst(
c BeforeString:count:3)))
c eval count +=2
c iter
*
c when LastOne = *blanks or
c LastOne = '-' or
c LastOne = '.' or
c LastOne = '/'
c eval AfterString = %Subst(
c AfterString:1:count-1)
c + %Trim(
c %Xlate(Lo:Up:%Subst(
c BeforeString:count:1)) +
c %Subst(AfterString:count+1))
c other
c eval %subst(AfterString:count:1) =
c %subst(BeforeString:count:1)
c endsl
*
c eval LastOne = %subst(BeforeString:count:1)
c endfor
*
c return AfterString
p TITLE E
To test this all you need is a program like below.
To create this test program named (TEST):
use option 15 From PDM
- CRTRPGMOD MODULE(JJFLIB/TITLE) SRCFILE(JJFLIB/QRPGLESRC)
SRCMBR(TITLE) DBGVIEW(*SOURCE)
- CRTPGM JJFLIB/TEST MODULE(TEST TITLE)
/copy source,TITLE_CP
d InString s 28
d Test s 28
c *entry plist
c parm InString
*
c eval Test = TITLE(InString)
c Test dsply reply 1
c eval *inlr = *on
|
| |