-
Kann aber schon sein, dass Du mit deiner Methode u.U. sechs Felder benötigst oder?
Nämlich in dem Fall, wenn Du ein "abgehacktes" Wort auf eine neue Zeile übertragen musst.
kf
-
 Zitat von camouflage
Kann aber schon sein, dass Du mit deiner Methode u.U. sechs Felder benötigst oder?
Nämlich in dem Fall, wenn Du ein "abgehacktes" Wort auf eine neue Zeile übertragen musst.
Ja.
P.S. Es ging um den Ansatz (der Monitor hätte übrigens neben 51stelligen Worthülsen auch $I>5 zum Bahnhof geschickt)
-
Warum wollt Ihr denn partout die Räder neu erfinden!
Kopiert doch einfach den folgenden Source Code, der eine Kopie der Funktionen WRAPTEXT und REPLACE (wird aus WRAPTEXT aufgerufen) von Michael Sansosterra enthält in eine Quelle, wandelt das Ding mit 14 in ein Programm um und führt es aus!
Code:
D WrapText PR 12288
D UnfText 8192 Varying Const Options(*VarSize)
D LineLen 5 0 Const
D LineBreak 10 Varying Const Options(*NoPass)
DReplace PR 8192 Varying
D parmSearchStr 8192 Varying Const Options(*VarSize)
D FindStr 8192 Varying Const Options(*VarSize)
D ReplaceStr 8192 Varying Const Options(*VarSize)
//******************************************************************
D OrigText S 250A Varying
D DSText DS Qualified
D Text1 52A
D Text2 52A
D Text3 52A
D Text4 52A
D Text5 52A
D Text6 52A
D FGText 52A Dim(6) Overlay(DSText)
D Index S 3U 0
//**********************************************************************
/Free
OrigText = 'Wieso sollte die Funktion WRAPTEXT von Michael +
Sansosterra den Erfordernissen nicht entsprechen? +
M.E. ist dies genau was gefordert wurde. +
Man muss dieses Programm, das eine Kopie der +
Funktion enthält umwandeln, ausführen +
und das Ergebnis anschauen!';
DSText = WrapText(OrigText: %Len(DSText.Text1));
For Index = 1 to %Elem(DSText.FGText);
Dsply DSText.FGText(Index);
EndFor;
*InLR = *On;
/END-FREE
//**********************************************************************
P WrapText B
D WrapText PI 12288
D UnfText 8192 Varying Const Options(*VarSize)
D LineLen 5 0 Const
D LineBreak 10 Varying Const Options(*NoPass)
// Work Fields
D WrkText s + 1 Like(UnfText)
D LineText s 12288
D WordText s Like(UnfText)
D FmtText s 12288
D WordLen s 5 0
// Word/Line counters
D Line s 5 0
D Word s 5 0
//-----------------------------------------------------------------------
/Free
WrkText=%TrimL(UnfText)+' ';
If %Parms>=3;
If %Len(LineBreak)>0;
WrkText=Replace(WrkText:LineBreak:' '+LineBreak+' ');
EndIf;
EndIf;
If LineLen<=*Zero Or LineLen>%Size(UnfText);
Return 'INVALID LEN*';
EndIf;
If UnfText=*Blank;
Return '';
EndIf;
Dow %Len(WrkText)>*Zero;
// Find Boundary of word
WordLen=%Scan(' ':WrkText)-1;
If WordLen>*Zero;
// Test if Word length is greater than the wrap length
If WordLen>LineLen ;
WordText=%Subst(WrkText:1:LineLen);
WrkText=%Subst(WrkText:LineLen+1);
Else;
WordText=%Subst(WrkText:1:WordLen);
WrkText=%TrimL(%Subst(WrkText:WordLen+1));
EndIf;
// Test if break was requested
If %Parms=3;
If WordText=LineBreak;
WordText=' ';
ExSr BuildLine;
EndIf;
EndIf;
// If Length of Current Line + Length of the current word
// > than formatted line length, make a new line
If %Len(%TrimR(LineText)) + %Len(WordText)+1>LineLen
And %Len(%TrimR(LineText))>0;
ExSr BuildLine;
EndIf;
// Append Word to current Line
// NOTE: Word will be blank if a line break specified
If WordText<>*Blanks;
Word=Word+1;
If Word=1;
LineText=WordText;
Else;
LineText=%TrimR(LineText)+' '+WordText;
EndIf;
EndIf;
EndIf;
EndDo;
// Build Remaining Line
If LineText<>*blanks;
ExSr BuildLine;
EndIf;
Return FmtText;
// Build Single Line according to the requested format width
BegSr BuildLine;
Word=*Zero;
If Line=*Zero;
FmtText=%Subst(LineText:1:LineLen);
Else;
If LineLen*Line>%Size(FmtText);
LeaveSr;
Else;
FmtText=%Subst(FmtText:1:LineLen*Line) +
%Subst(LineText:1:LineLen);
EndIf;
EndIf;
Line=Line+1;
LineText=*Blank;
EndSr;
/End-Free
P WrapText E
//*******************************************************************
// Find and Replace a string
//*******************************************************************
PReplace B
DReplace PI 8192 Varying
D parmSearchStr 8192 Varying Const Options(*VarSize)
D FindStr 8192 Varying Const Options(*VarSize)
D ReplaceStr 8192 Varying Const Options(*VarSize)
D SearchStr S 8192 Varying Static
D Pos S 5i 0
D SL S 5i 0
D FL S 5i 0
/Free
SearchStr=parmSearchStr;
FL=%Len(FindStr);
Pos=*zero;
Dow pos + fl<=%Len(SearchStr);
SL=pos+1;
Pos=%Scan(FindStr:SearchStr:sl);
// Leave if search string isn't found
If Pos=*Zero;
Leave;
EndIf;
// Build new string with replaced text in the middle
If Pos + fl > %Len(SearchStr);
SearchStr=%Subst(SearchStr:1:Pos-1) + ReplaceStr;
Else;
SearchStr=%Subst(SearchStr:1:Pos-1) + ReplaceStr +
%Subst(SearchStr:Pos + fl);
EndIf;
// Set starting position for search of next occurance
Pos=Pos+%Len(ReplaceStr)-1;
EndDo;
Return SearchStr;
/End-Free
P Replace E
Birgitta
-
Zitat von B.Hauser
Warum wollt Ihr denn partout die Räder neu erfinden!
@Birgitta,
nicht neu erfinden, nur einfacher...
Siehe hier:
Code:
D $strng s 8192
D $text s 250
D $cvtxt DS 8192 qualified
D Feld1 50A
D Feld2 50A
D Feld3 50A
D Feld4 50A
D Feld5 50A
D Feld6 50A
D $start S 5U 0 inz(1)
D $end S 5U 0
D $len S 5U 0
/free
$text = 'Wieso sollte die Funktion WRAPTEXT von Michael +
Sansosterra den Erfordernissen nicht entsprechen? +
M.E. ist dies genau was gefordert wurde. +
Allerdings geht das einiges einfacher und vor allem +
verständlicher. +
Wieso mit Kanonen auf Spatzen schiessen?';
$strng = $Text;
exsr $Wrap;
... do what ever you want...
*inlr = *on;
// Convert Fliesstext in eine Datenstruktur
begsr $Wrap;
$len = %len($cvtxt.Feld1);
$end = $len;
dow $strng <> *blanks;
dow %subst($strng:$end:1) <> *blank
and $end > 1;
$end -= 1;
enddo;
if $end > $len or $end <= 1; // overflow
$end = $len;
endif;
%subst($cvtxt:$start:$len)=%subst($strng:1:$end);
$strng = %trim(%subst($strng:$end))+' ';
$start += $len;
$end = $len;
enddo;
endsr;
/end-free
Alternativ mit Arrays arbeiten.
@Robert
Gute Idee der Shift - alte Schule, gelernt ist gelernt. ;-)
Just my 2ct's
kf
-
Hallo Zusammen,
erst einmal möchte ich mich bei allen die hier geantwortet haben bedanken.
Ich habe es so wie Birgitta geschrieben hat umgesetzt und es funktioniert.
Nochmals vielen Dank
Similar Threads
-
By USDAVIS in forum IBM i Hauptforum
Antworten: 4
Letzter Beitrag: 19-01-12, 14:03
-
By cicero22 in forum IBM i Hauptforum
Antworten: 4
Letzter Beitrag: 14-10-05, 06:24
-
By c_kinkel in forum IBM i Hauptforum
Antworten: 1
Letzter Beitrag: 15-07-05, 09:16
-
By sim in forum NEWSboard Programmierung
Antworten: 2
Letzter Beitrag: 30-08-04, 07:30
-
By JoergHamacher in forum NEWSboard Programmierung
Antworten: 5
Letzter Beitrag: 24-08-04, 12:21
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
|
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[professional_User]
Mit Zitat antworten
Bookmarks