-
Hallo Sascha,
ich habe da ein kleines Tool in RPGLE zum Umsetzen von Text. Ist nur so als Anregung
Code:
*
* Programm dient zur Umwandlung von Texten
*
* Übergabe Parameter
* text 255 den zu konvertierenten Text
* art 2 Art der Umwandlung
* 'KG' = klein --> GROß
* 'GK' = GROß --> Klein
* '1G' = erster Buchstabe GROß rest klein
* 'ÖO' = ö,Ö,ü,Ü,ä,Ä --> oe,OE,ue,UE,ae,AE
* 'OÖ' = oe,OE,ue,UE,ae,AE --> ö,Ö,ü,Ü,ä,Ä
*
* ret_code 1 Fehlerzeiger ist 'F' wenn art nicht gültig
*
*
d sds
d parmanz *parms
d job 244 253
d user 254 263
d
d
d art s 2 Umwandluns-Kz
d ret_code s 1 Fehlerzeiger
d text s 255
d pos s 3 0 Position im String
d ds
d xtext 255 Umsetzungstxt
d erstes_zei 1 overlay(xtext:1)
d
d low c const('abcdefghijklmnopqrstuvwxyz')
d upp c const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
d
c Select
c When art = 'KG'
c Exsr klein_gross
c When art = 'GK'
c Exsr gross_klein
c When art = '1G'
c Exsr erster_gross
c When art = 'ÖO'
c Exsr umlaut_1
c When art = 'OÖ'
c Exsr umlaut_2
c Other
c If parmanz = 3
c Eval ret_code = 'F'
c Endif
c Endsl
c
c Eval text = xtext
c Eval *inlr = *on
*
*
****************** klein_gross *******************************************
*
*
c klein_gross Begsr
c*
c low:upp xlate xtext xtext
c*
c Endsr
*
*
****************** gross_klein *******************************************
*
*
c gross_klein Begsr
c*
c upp:low xlate xtext xtext
c*
c Endsr
*
*
****************** erster_gross ******************************************
*
*
c erster_gross Begsr
c*
c upp:low xlate xtext xtext
c low:upp xlate erstes_zei erstes_zei
c*
c Endsr
*
*
****************** umlaut_1 **********************************************
*
*
c umlaut_1 Begsr
c*
c Eval pos = %scan('ö':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('oe':xtext:pos:1)
c Eval pos = %scan('ö':xtext)
c Enddo
c Eval pos = %scan('Ö':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('OE':xtext:pos:1)
c Eval pos = %scan('Ö':xtext)
c Enddo
c Eval pos = %scan('ü':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('ue':xtext:pos:1)
c Eval pos = %scan('ü':xtext)
c Enddo
c Eval pos = %scan('Ü':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('UE':xtext:pos:1)
c Eval pos = %scan('Ü':xtext)
c Enddo
c Eval pos = %scan('ä':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('ae':xtext:pos:1)
c Eval pos = %scan('ä':xtext)
c Enddo
c Eval pos = %scan('Ä':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('AE':xtext:pos:1)
c Eval pos = %scan('Ä':xtext)
c Enddo
c*
c Endsr
*
*
****************** umlaut_2 **********************************************
*
*
c umlaut_2 Begsr
c*
c Eval pos = %scan('oe':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('ö':xtext:pos:1)
c Eval pos = %scan('oe':xtext)
c Enddo
c Eval pos = %scan('OE':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('Ö':xtext:pos:1)
c Eval pos = %scan('OE':xtext)
c Enddo
c Eval pos = %scan('ue':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('ü':xtext:pos:1)
c Eval pos = %scan('ue':xtext)
c Enddo
c Eval pos = %scan('UE':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('Ü':xtext:pos:1)
c Eval pos = %scan('UE':xtext)
c Enddo
c Eval pos = %scan('ae':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('ä':xtext:pos:1)
c Eval pos = %scan('ae':xtext)
c Enddo
c Eval pos = %scan('AE':xtext)
c Dow pos > *zeros
c Eval xtext = %replace('Ä':xtext:pos:1)
c Eval pos = %scan('AE':xtext)
c Enddo
c*
c Endsr
*
*
****************** *inzsr ************************************************
*
*
c *inzsr Begsr
c*
c *entry Plist
c Parm text
c Parm art
c Parm ret_code
c
c
c Eval xtext = text
c*
c Endsr
Gruß Ronald
Similar Threads
-
By mk in forum NEWSboard Java
Antworten: 8
Letzter Beitrag: 21-04-11, 22:51
-
By robertki in forum NEWSboard Programmierung
Antworten: 25
Letzter Beitrag: 19-01-07, 09:42
-
By timeless in forum IBM i Hauptforum
Antworten: 5
Letzter Beitrag: 11-01-07, 13:04
-
By Stoeberl in forum NEWSboard Programmierung
Antworten: 8
Letzter Beitrag: 10-01-07, 11:58
-
By jth in forum NEWSboard Programmierung
Antworten: 1
Letzter Beitrag: 21-12-06, 12:13
Berechtigungen
- Neue Themen erstellen: Nein
- Themen beantworten: Nein
- You may not post attachments
- You may not edit your posts
-
Foren-Regeln
|
Erweiterte Foren Suche
Google Foren Suche
Forum & Artikel Update eMail
AS/400 / IBM i
Server Expert Gruppen
Unternehmens IT
|
Kategorien online Artikel
- Big Data, Analytics, BI, MIS
- Cloud, Social Media, Devices
- DMS, Archivierung, Druck
- ERP + Add-ons, Business Software
- Hochverfügbarkeit
- Human Resources, Personal
- IBM Announcements
- IT-Karikaturen
- Leitartikel
- Load`n`go
- Messen, Veranstaltungen
- NEWSolutions Dossiers
- Programmierung
- Security
- Software Development + Change Mgmt.
- Solutions & Provider
- Speicher – Storage
- Strategische Berichte
- Systemmanagement
- Tools, Hot-Tips
Auf dem Laufenden bleiben
|
Bookmarks