RegExp å bryt ord!

AsaMedlem sedan dec. 20011 860 inlägg

Frågan12 sep. 2002 07:52#1

Har en kod som ska bryta ord efter 50 tecken och nu till problemet. Om man har en länk som är över 50 tecken så delas de på två rader men nu vill jag att de ska kunna sitta ihop! Kanske finns nå bättre sätt?

Min kod:

Function Link(strText)

   '#====================================================#
   '                      Skapad av: Mattias @ Aspsidan.nu Copyright 2002
   '#====================================================#

	iPos1 = 1	
	iPos2 = 1
	iWordLength = 0

	strText = Trim(strText) 			

	Do Until iPos2 = Len(strText)			
		iPos2 = iPos2 + 1			

		iWordLength = iWordLength + 1 	

		If InStr(iPos2,Mid(strText,iPos2,Len(strText)),vbNewLine)>1 Then  
				iWordLength = 0  
		End if 
 
		If Mid(strText,iPos2,1) = " " Then  
				iWordLength = 0 
		End if

		If iWordLength > 50 Then
			strText = Mid(strText,1,iPos1-1) & Mid(strText,iPos1,iPos2-iPos1) & " " & Mid(strText,iPos2,Len(strText)-iPos2+1)
	
			iPos1 = iPos2
			iPos2 = iPos2 + 1
			iWordLength = 0
		End If
	Loop

   '#====================================================#
   '                      Skapad av: Ricki @ Ricki.nu Copyright 2002
   '#====================================================#

   Set regExp = New regexp

   regExp.Global = true
   regExp.IgnoreCase = true

   regExp.Pattern = "([url]http://[/url]|www)([\S]*)"
   strText = regExp.Replace(strText,"<a href=""http://$1$2"" target=""_blank"">$1$2</a>")

   regExp.Pattern = "([url]ftp://[/url])([\S]*)"
   strText = regExp.Replace(strText,"<a href=""$1$2"" target=""_blank"">$1$2</a>")

   regExp.Pattern = "([\S]*@[\S]*[.se|.com|.nu|.net|.org])"
   strText = regExp.Replace(strText,"<a href=""mailto:$1"" target=""_blank"">$1</a>")

   regExp.Pattern = "([.|,|!|?|:|;|)|\|&]]*)</a> "
   strText = regExp.Replace(strText,"</a>$1 ")

   regExp.Pattern = "([.|,|!|?|:|;|)|\|&]]*)"" target=""_blank"">([^<]*)</a>"
   strText = regExp.Replace(strText,""">$2</a>")

   '#====================================================#

strText    = Replace(strText,"[f]","<b>")
strText    = Replace(strText,"[/f]","</b>")
strText    = Replace(strText,"[k]","<i>")
strText    = Replace(strText,"[/k]","</i>")
strText    = Replace(strText,"&lt;%","<font color=#FF0000>&lt;%</font>")
strText    = Replace(strText,"%&gt;","<font color=#FF0000>%&gt;</font>")
strText    = Replace(strText,"[farg]","<font color=#800000>")
strText    = Replace(strText,"[farg]","<font color=#800000>")
strText    = Replace(strText, vbCrLf, "<br>") 
strText    = Replace(strText,"http://http://","http://")

Link = strText 				' Skriver ut texten, uppdelad och fin!

End Function

tohaMedlem sedan dec. 1999707 inlägg

12 sep. 2002 16:12#2

Är det kanske en sån här funktion du söker:

Function breakString(ByVal sText, ByVal lMaxLength)
	
	Const BREAK_CHAR =	"<br>"
	Dim sOutput, sTmp
	Dim i

	lMaxLength = lMaxLength + 1
	If Len(sText) < lMaxLength then
		breakString =	sText
	Else
		Do While Len(sText) >= lMaxLength
			sTmp =	Left(sText, lMaxLength+1)
			i =		InStrRev(sTmp, " ")
			If i > 0 then
				sOutput =	sOutput & Left(sTmp, i-1) & BREAK_CHAR
			Else
				i =		InStr(sText, " ")
				If i = 0 then	i = Len(sText)
				sOutput =	sOutput & Left(sText, i-1) & BREAK_CHAR
			End if
			sText =		Mid(sText, i+1)
		Loop
		breakString =	sOutput & Trim(sText)
	End if

End Function