durchlaufender Text im Fenster

[MVXA]

> Leider gibt es in PB kein "split"
PB kennt aber was ähnliches, StringField(String$, Index, Seperator$)

[PureLust]

Hi Sigi, ...

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
End

Um zu sehen wie die Prozeduren arbeiten, brauchst Du nur mit der Maus ein wenig über das Fenster zu fahren. Daraufhin werden dem bestehenden Text immer mehr Zufallszahlen hinzugefügt und der angezeigte Text wird länger und länger.

In 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.

[der-sigi]

Hallole

MXVA: Danke. Habe ich mir schon angeschaut. Ist aber recht umständlich gegenüber den von mir erwähnten Befehlen anderer Sprachen. Oder ist Basci immer so umständlich (nicht hauen, habe nur laut gedacht). ;)

PureLust: Wow, da hast du dir ja richtig Mühe gemacht. Klasse. Das können sicher viele gebrauchen, wenn PB4 mal aus der Beta Phase ist. Aber auf PB3.94 rennt das nicht. Sehe ich das richtig, daß du praktisch immer ein Zeilenbild "malst" um die Textweite zu ermitteln? Ganz schön viel Aufwand für so ein bißchen Gezappel. ;) Danke nochmal, werde mal versuchen ob ich das auch in PB3.94 hinbekomme.

Viele Grüße
Sigi

[PureLust]

Hallo Sigi, ...

nein, ich 'male' nicht die Zeilen, sondern ich verwende einfach die Funktion 'TextWidth()' um die Länge in Pixeln zu berechnen.
Ich gehe mal davon aus, das OS-intern jedes Element (Gadget), welches einen Wortumbruch unterstützt, so in etwa arbeiten wird.
Um hierfür auch den richtigen Font nehmen zu können muss ich leider in PB einen Ausgabekanal öffnen - daher das Image und das StartDrawing().

Wenn ich gleich noch ein wenig Zeit habe werde ich Dir noch kurz eine 3.94 Version nachschieben.

Greetz, PureLust.

[der-sigi]

Hi PureLust

Danke für's Nachschieben, denn mit PB3.94 bin ich doch gleich an dem TextWidth() hängen geblieben - gibt es nicht.

Viele Grüße
Sigi

[PureLust]

Hi again, ...

anbei also mal der v3.94 kompatible Code.

Was TextWidth() anbelangt, so hies das früher einfach nur TextLength().

Aber beim 'zurück' konvertieren nach v3.94 ist mir einmal mehr bewusst geworden um wievieles besser die v4 gegenüber der v3.94 ist !!!
An dieser Stelle nochmals ein RIESEN Lob an Fred und das Team !!!
(Ich hätte da zwar noch so einige Anmerkungen und Verbesserungsvorschläge, aber ich schätze mal, dass die genug zu tun haben. )

Aber hier nun der v3.94 Code:

Code: Alles auswählen

Procedure.s WordWrap(Text.s, MaxWidth.w, FontID.l, LineSplit.s)
	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
	Separators.s = " :;-_!§$%&/()={[]}?ß\+*#"
	DummyImage = CreateImage(#PB_Any,1,1)
	If DummyImage
		If StartDrawing(ImageOutput())
			DrawingFont(FontID)
			SpaceWidth = TextLength(" ")
			StartChar = MaxWidth / SpaceWidth
			WorkText = Text
			Repeat
				If Len(WorkText) < StartChar : StartChar = Len(WorkText) : EndIf
				MaxChar = StartChar
				For n = StartChar To 1 Step -1
					If TextLength(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, LineSplit.s)
	Protected	LineCounter.l , AktTextPos.l, AktSearchPos.l
	Protected	TLen.l, SLen.l, UpperSearchPos.l, LowerSearchPos.l
	TLen = Len(Text)
	SLen = Len(LineSplit)
	UpperSearchPos = 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

DefType.l AktEvent, GadgetBorderWidth
GadgetBorderWidth = 3

If OpenWindow(0,1,1,500,400,#PB_Window_SystemMenu,"Wortumbruch & LineLimit")
	If CreateGadgetList(WindowID(0))
		TextGadget(0,1,1,WindowWidth()/2-4, WindowHeight()-1,"Zeile 1",#PB_Text_Border)
		TextGadget(1,WindowWidth()/2,1,WindowWidth()/2-2, WindowHeight()-1,"",#PB_Text_Border)
		Repeat
			AktEvent = WaitWindowEvent()
			If Len(GetGadgetText(0)) > 3000 : SetGadgetText(0,"") : EndIf
			SetGadgetText(0,GetGadgetText(0)+" "+StrF(Random(200000)/1000,3))
			SetGadgetText(1,LimitLines(WordWrap(GetGadgetText(0),GadgetWidth(1)-GadgetBorderWidth,GetGadgetFont(1),Chr(13)+Chr(10)),30,1,Chr(13)+Chr(10)))
		Until AktEvent = #PB_Event_CloseWindow
	EndIf
EndIf
End

Die Kommentarzeilen hab ich mir diesmal gespart um das Post nicht zu lang zu machen.
Wenn nötig kannst Du sie Dir ja aus dem v4-Code herauskopieren.

Gruß, PureLust.

[Kaeru Gaman]

textwidth/length is natürlich die elegantere methode...

ich hätte da einfach auf nen typen-zeichensatz wie Courier zurückgegriffen und wär mit Len() vorgegangen...


> Nur, warum schiebt das bei einem chr(13)+chr(10) (bei Windows) um eine Zeile hoch und bei dem eigenen Umbruch nur eine halbe Zeile!?

das liegt wohl an windows selber... CRLF isn absatz, ein umbruch nicht.
auch in Word beispielsweise werden die durch unterschiedliche attribute festgelegt...

[der-sigi]

Hallo Kaeru Gaman

>textwidth/length is natürlich die elegantere methode...
>ich hätte da einfach auf nen typen-zeichensatz wie Courier zurückgegriffen und wär mit Len() vorgegangen... ;)

Und wer will Courier, wenn sonst Helvetica angezeigt wird. Und woher weißt du wieviel "len()" Zeichen dann in die Breite reingehen? Ich denke, daß wäre keine gute Lösung gewesen. :)

Viele Grüße
Sigi

[der-sigi]

Hallo PureLust

nochmals ein dickes DANKESCHÖN!
Habe es mal kurz angetestet und es sieht gut aus.

Viele Grüße
Sigi

[Kaeru Gaman]

> Und wer will Courier, wenn sonst Helvetica angezeigt wird.
jemand, der zu faul is, sich den längen-strumpf zu geben

> Und woher weißt du wieviel "len()" Zeichen dann in die Breite reingehen?
ausprobieren

> Ich denke, das wäre keine gute Lösung gewesen.
ne einfache lösung wärs gewesen


btw: benutz den EDIT-Button....