Verfasst: 19.04.2006 16:51
> Leider gibt es in PB kein "split"
PB kennt aber was ähnliches, StringField(String$, Index, Seperator$)
PB kennt aber was ähnliches, StringField(String$, Index, Seperator$)
ich fand Dein Anliegen ganz interessant und hab mich mal drangesetzt zwei kleine Prozeduren zu schreiben, mit denen Du hoffentlich das gewünschte Ergebnis erzielen kannst.
Die Procs sind möglichst allgemein gehalten, so dass sie ja vielleicht auch an anderer Stelle Verwendung finden könnten.
Die erste Prozedur bricht Dir einen Text auf einer gewünschten Breite wortweise um und liefert Dir den umgebrochenen Text mit Zeilenseparatoren wieder zurück.
Die zweite Prozedur limitiert Dir einen übergebenen Text auf eine maximale Anzahl von Zeilen, wobei man wählen kann, ob der vordere oder der hintere Teil des Textes 'beschnitten' werden soll.
Anbei mal der hoffentlich ausreichend dokumentierte PB4-Code samt einer kleiner Demonstration:
Code: Alles auswählen
EnableExplicit
Procedure.s WordWrap(Text.s, MaxWidth.w, FontID.l, LineSplit.s = Chr(13)+Chr(10))
; Diese Prozedur bricht einen Text wortweise um, wenn er länger als 'MaxWidth' Pixel ist,
; unter berücksichtigung der Schriftart und Größe des Fonts mit der übergebenen 'FontID'.
; Hierbei werden die Zeichen in der Variable 'Separators.s' als Wortseparatoren verwendet.
;
; Der Rückgabewert beinhaltet den Umgebrochenen Text, wobei die einzelnen Zeilen durch
; die Zeichen in der Variable 'LineSplit.s' getrennt werden.
; Die oben erwähnten Zeichen für die Wortseparation in der Variable 'Separators' können natürlich nach belieben angepasst werden.
;
; Text = Text, der umgebrochen werden soll
; MaxWidth = Breite in Pixel, die der umgebrochenen Text maximal haben soll
; FontID = ID des Fonts, auf dessen Basis die Berechnung der Textbreite durchgeführt wird
; (Achtung: es wird die FontID() benötigt, nicht die #FontNummer.)
; LineSplit = Hier können die Zeichen übergeben werden, die für einen 'Zeilenvorschub' verwendet werden sollen.
; (optional) Standardmäßig wird hierbei CR+LF - also Chr(13)+Chr(10) - verwendet
;
Protected Separators.s = " :;-_!§$%&/()={[]}?ß\+*#" ; Wort-Separatoren - können nach belieben verändert werden
Protected DummyImage.l ; Wird benötigt um einen Dummy-Ausgabekanal zum Setzen des Fonts zu öffnen.
Protected WorkText.s, ReturnText.s, SpaceWidth.b, StartChar.w, MaxChar.w, n.w
DummyImage = CreateImage(#PB_Any,1,1,32)
If DummyImage
If StartDrawing(ImageOutput(DummyImage))
DrawingFont(FontID)
SpaceWidth = TextWidth(" ")
StartChar = MaxWidth / SpaceWidth
WorkText = Text
Repeat
If Len(WorkText) < StartChar : StartChar = Len(WorkText) : EndIf
MaxChar = StartChar
For n = StartChar To 1 Step -1
If TextWidth(Left(WorkText,n)) <= MaxWidth
If FindString(Separators,Mid(WorkText,n,1),1) Or n = StartChar : Break : EndIf
Else
MaxChar = n-1
EndIf
Next n
If n > 0
ReturnText + Left(WorkText,n) + LineSplit
WorkText = Mid(WorkText,n+1,Len(WorkText))
Else
ReturnText + Left(WorkText,MaxChar) + LineSplit
WorkText = Mid(WorkText,MaxChar+1,Len(WorkText))
EndIf
Until Len(WorkText)=0
StopDrawing()
EndIf
FreeImage(DummyImage)
ProcedureReturn Left(ReturnText,Abs(Len(ReturnText)-Len(LineSplit)))
EndIf
EndProcedure
Procedure.s LimitLines(Text.s, Lines.l, CutPos.b=0, LineSplit.s = Chr(13)+Chr(10))
; Diese Prozedur limitiert einen Text auf eine maximale Anzahl von Zeilen.
; Hierbei werden die Zeichen in der Variable 'LineSplit.s' als Zeilenseparator verwendet.
; Das Beschneiden des Textes kann sowohl am Ende, wie auch am Anfang des Textes erfolgen.
; Die zur Zeilenerkennung verwendeten Zeichen können optional in 'LineSplit.s' übergeben werden.
;
; Der Rückgabewert beinhaltet den (wenn nötig) beschnittenen Text.
;
; Text = Text, der evtl. beschnitten werden soll
; Lines = Anzahl der Zeilen, die der zurückgegebene Text maximal haben soll.
; CutPos = Position an der 'beschnitten' werden soll.
; (optional) 0 = beschneiden am Ende (Default)
; 1 = beschneiden am Anfang
; LineSplit = Hier können die Zeichen übergeben werden, die als einen 'Zeilenvorschub' erkannt werden.
; (optional) Standardmäßig wird hierbei CR+LF - also Chr(13)+Chr(10) - verwendet
;
Protected LineCounter.l , AktTextPos.l, AktSearchPos.l
Protected TLen.l = Len(Text), SLen = Len(LineSplit), UpperSearchPos.l = TLen, LowerSearchPos = 0
If CountString(Text,LineSplit) >= Lines
If CutPos = 0 ; Text am Ende beschneiden
Repeat
AktTextPos = FindString(Text+LineSplit,LineSplit,AktTextPos+1)
LineCounter + 1
Until LineCounter >= Lines
ProcedureReturn Left(text,AktTextPos-1)
Else ; Text am Anfang beschneiden
AktSearchPos = (UpperSearchPos-LowerSearchPos)/2
Repeat
If CountString(Mid(Text,AktSearchPos,TLen),LineSplit) >= Lines
LowerSearchPos = AktSearchPos
Else
UpperSearchPos = AktSearchPos
EndIf
AktSearchPos = LowerSearchPos + Abs(UpperSearchPos-LowerSearchPos)/2
Until LowerSearchPos = AktSearchPos Or UpperSearchPos = AktSearchPos
ProcedureReturn Mid(Text,UpperSearchPos+SLen-1,TLen)
EndIf
Else
ProcedureReturn Text
EndIf
EndProcedure
Define Event.l
If OpenWindow(0,1,1,500,400,"Wortumbruch & LineLimit")
If CreateGadgetList(WindowID(0))
TextGadget(0,1,1,WindowWidth(0)/2-2, WindowHeight(0)-1,"Zeile 1")
TextGadget(1,WindowWidth(0)/2+1,1,WindowWidth(0)/2-2, WindowHeight(0)-1,"")
SetGadgetColor(0,#PB_Gadget_BackColor,$8888aa)
SetGadgetColor(1,#PB_Gadget_BackColor,$998888)
Repeat
Event = WaitWindowEvent()
If Len(GetGadgetText(0)) > 3000 : SetGadgetText(0,"") : EndIf
; Wenn der Text zu lang wird, lösche ihn wieder
SetGadgetText(0,GetGadgetText(0)+" "+StrF(Random(200000)/1000,3))
; Hier wurde einfach dem Text eine zufällige Zahl hinzugefügt um ihn länger zu machen.
SetGadgetText(1,LimitLines(WordWrap(GetGadgetText(0),GadgetWidth(1),GetGadgetFont(1)),30,1))
; Die obere Zeile bedeutet:
; 1. Wortumbruch des Textes aus dem linken Text-Gadget <= GetGadgetText(0)
; - Limitiere hierbei den Text auf die Breite des Gadgets <= GadgetWidth(1)
; - und benutze dessen Font für die Breitenberechnung <= GetGadgetFont(1)
; 2. Limitiere die Anzahl der Linien auf 30 <= 30
; - und schneide hierbei den vorderen Teil ab. <= 1
Until Event = #PB_Event_CloseWindow
EndIf
EndIf
EndIn der linken Hälfte siehst Du den Text einfach in einem normalen Text-Gadget angezeigt (mit dem Gadget-eigenen Wortumbruch) und in der rechten Hälfte siehst Du den von den o.g. Prozeduren bearbeiteten Text samt eigenem Wortumbruch und Zeilenbegrenzung, wodurch der Text sauber nach oben weg scrollt.
Ich hoffe Du - und vielleicht ja auch noch andere - können was damit anfangen.
Gruß, PureLust.
