by Doug Pederson (1 Submission)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 29th November 2006
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This is the line wrap and highlight code from my search engine. see the matching flowcharts at:
API Declarations
I finally got around to fixing some of the minor wrap and highlight problems.
The flowchart was redrawn 4 or 5 times in that period as I tested and tested.
This code works I pass it the X number of lines before the match then the
match line, then more lines to fill the rest of the screen.
VBcoders
'need the tabs to spaces where it is. Spaces may be in the search for matches?
' test to eliminate excess prints
'20 May 2003 note I may want to de-activate the following change along with
' the other one for 20 May 2003 this data is now displayed in
' the detail display / caption option....
' If sscreen_saver = "Y" Then GoTo line_13999 '20 May 2003
' testprompt = InputBox("testing prompt 12050=" + sscreen_saver + " " + disp_file + " " + aaa, "test", , 4400, 4500) '
line_12050: 'january 15 2001
If array_pos <> 0 Then
data_aaa = aaa + ""
data_ooo = ooo + ""
endstuff = "YES"
array_prt = array_prt + 1
aaa = array_aaa(array_prt)
ooo = array_ooo(array_prt)
SSS1 = KEEPS1 'january 24 2001
If SSS1 = "A" Then SSS1 = "" 'january 25 2001
SSS2 = KEEPS2
SSS3 = KEEPS3 'january 24 2001
SSS4 = KEEPS4 '09 june 2002
SSS5 = KEEPS5
SSS6 = KEEPS6
' testprompt = InputBox("testing prompt 12050=" + CStr(array_prt) + " " + data_ooo + " " + CStr(array_pos) + " " + array_ooo(array_prt), "test", , 4400, 4500) '
GoTo line_12120 'january 21 2001
End If
line_12053: 'january 21 2001
endstuff = "NO" 'january 21 2001
data_aaa = aaa + " "
data_ooo = ooo + " "
tot_print = 0
line_12055:
'below reduce multiple trailing spaces to 1
JJ = Len(data_aaa)
If JJ < 2 Then GoTo line_12070
If Right(data_aaa, 2) = " " Then
data_aaa = Left(data_aaa, JJ - 1)
data_ooo = Left(data_ooo, JJ - 1)
GoTo line_12055
End If
line_12070:
aaa = data_aaa + ""
ooo = data_ooo + ""
line_12100:
'now do a search for the match strings.
match_flag = "YES"
'is there a match of the 3 elements in this string YES or NO
If SSS1 = "" Then match_flag = "NO"
If SSS1 <> "" And InStr(aaa, SSS1) = 0 Then
match_flag = "NO"
GoTo line_12110
End If
If SSS2 <> "" And InStr(aaa, SSS2) = 0 Then
match_flag = "NO"
GoTo line_12110
End If
'23 june 2002 add 4 5 and 6 below
If SSS3 <> "" And InStr(aaa, SSS3) = 0 Then
match_flag = "NO"
GoTo line_12110
End If
If SSS4 <> "" And InStr(aaa, SSS4) = 0 Then
match_flag = "NO"
GoTo line_12110
End If
If SSS5 <> "" And InStr(aaa, SSS5) = 0 Then
match_flag = "NO"
GoTo line_12110
End If
If SSS6 <> "" And InStr(aaa, SSS6) = 0 Then match_flag = "NO"
line_12110:
If Len(aaa) > line_len + over_lap Then
GoTo line_13000 'do the line wrap inserts etc
End If
line_12120: 'return from the wrap logic here if required.
' If zzz_cnt > 43180 Then
' testprompt = InputBox("testing prompt 12120=" + match_flag + "*" + SSS1 + "*" + SSS2 + "*" + SSS3 + "*" + SSS4 + "*" + SSS5 + "*" + SSS6, , , 4400, 4500) 'TESTING ONLY
' If tt1 = "X" Or tt1 = "x" Then
' GoTo End_32000
' End If 'testing only
' End If
If match_flag = "YES" Then GoTo line_12500 '
line_12125:
If Left(UCase(Cmd(77)), 16) = "CHARACTERPAUSE==" Then '03 January 2005
new_delay_sec = Val(Right(Cmd(77), Len(Cmd(77)) - 16))
tempss = ooo '03 January 2005
For temp1 = 1 To Len(tempss)
Print Left(tempss, 1);
tempss = Right(tempss, Len(tempss) - 1)
GoSub line_30300 '03 January 2005
Next temp1
Else
Print ooo;
End If '03 January 2005
tot_print = tot_print + Len(ooo)
If extract_yes = "YES" Then
Print #ExtFile, ooo;
End If
'24 December 2004 put the timer in here???
If Left(Cmd(76), 11) = "LINEPAUSE==" Then
new_delay_sec = Val(Right(Cmd(76), Len(Cmd(76)) - 11))
GoSub line_30300 '24 December 2004
End If '24 December 2004
line_12130:
If array_prt > 1 Then
cnt = cnt + 1
wrap_cnt = wrap_cnt + 1
End If
posstring = "" 'december 6 2000
If showasc = "Y" Then
II = Len(ooo)
If II > 10 Then II = 10
ytemp = Right(ooo, II)
xtemp = ""
For III = 1 To II
xtemp = xtemp + CStr(Asc(Mid(ytemp, III, 1))) + " "
Next III
posstring = xtemp + "(" + ytemp + ")"
End If 'december 11 2000
If showpos = "Y" Then posstring = "*=" + CStr(tot_print) + " " + CStr(cnt)
Print ; posstring
'24 December 2004 put the timer in here???
If Left(Cmd(76), 11) = "LINEPAUSE==" Then
new_delay_sec = Val(Right(Cmd(76), Len(Cmd(76)) - 11))
GoSub line_30300 '24 December 2004
End If '24 December 2004
tot_print = 0
If extract_yes = "YES" Then
Print #ExtFile,
End If
'check for screen full here 'to be done yet
'at this point need to check for screen full and exit out if need be but do later
line_12135: 'january 21 2001
If cnt >= MAX_CNT Then
If array_prt = array_pos Then
array_prt = 0
array_pos = 0
End If
GoTo line_14222
End If
line_12140:
If array_pos < 1 Then GoTo line_14222
line_12150:
array_prt = array_prt + 1
line_12160:
If array_prt > array_pos Then
array_prt = 0
array_pos = 0
If endstuff = "YES" Then
aaa = data_aaa + ""
ooo = data_ooo + ""
GoTo line_12053 'january 21 2001
End If
GoTo line_14222
End If
line_12170:
aaa = array_aaa(array_prt) + ""
ooo = array_ooo(array_prt) + ""
GoTo line_12120
line_12500:
s1len = Len(SSS1)
s2len = Len(SSS2)
s3len = Len(SSS3)
s4len = Len(SSS4) '23 june 2002
s5len = Len(SSS5)
s6len = Len(SSS6)
GoSub sub_10000 'check for match in string aaa
If ss = 0 Then GoTo line_12125
line_12505:
If ss > 1 Then
If Left(UCase(Cmd(77)), 16) = "CHARACTERPAUSE==" Then '03 January 2005
new_delay_sec = Val(Right(Cmd(77), Len(Cmd(77)) - 16))
tempss = Left(ooo, ss - 1) '03 January 2005
For temp1 = 1 To Len(tempss)
Print Left(tempss, 1);
tempss = Right(tempss, Len(tempss) - 1)
GoSub line_30300 '03 January 2005
Next temp1
Else
' Print ooo;
Print Left(ooo, ss - 1);
tot_print = tot_print + ss - 1
If extract_yes = "YES" Then
Print #ExtFile, Left(ooo, ss - 1);
End If
End If '03 January 2005
End If
line_12510:
II = 0
If Mid(aaa, ss + sslen - 1, 1) <> " " Then GoTo line_12600
'if last chr in match a space check if that is the start of another match? below
If SSS1 = "" Then GoTo line_12600
If Mid(aaa, ss + sslen - 1, s1len) = SSS1 Then GoTo line_12550
If SSS2 = "" Then GoTo line_12600
If Mid(aaa, ss + sslen - 1, s2len) = SSS2 Then GoTo line_12550
If SSS3 = "" Then GoTo line_12600
If Mid(aaa, ss + sslen - 1, s3len) = SSS3 Then GoTo line_12550
If SSS4 = "" Then GoTo line_12600 '23 june 2002
If Mid(aaa, ss + sslen - 1, s4len) = SSS4 Then GoTo line_12550
If SSS5 = "" Then GoTo line_12600
If Mid(aaa, ss + sslen - 1, s5len) = SSS5 Then GoTo line_12550
If SSS6 = "" Then GoTo line_12600
If Mid(aaa, ss + sslen - 1, s6len) = SSS6 Then GoTo line_12550
GoTo line_12600
line_12550:
'only going to hi-lite up to the next space by reducing count by 1 below
' If zzz_cnt > 658 Then
' tt1 = InputBox("testing prompt 12550" + CStr(ss + sslen - 1) + "*" + Mid(aaa, ss + sslen - 1, 4) + "*" + SSS1, , , 4400, 4500) 'TESTING ONLY
' If tt1 = "X" Or tt1 = "x" Then
' GoTo End_32000
' End If 'testing only
' End If
sslen = sslen - 1
II = 1 'so the match counts below will jive
line_12600:
If UCase(Mid(ooo, ss, sslen + II)) = UCase(SSS1) Then tot_s1 = tot_s1 + 1 'january 01 2001
If UCase(Mid(ooo, ss, sslen + II)) = UCase(SSS2) Then tot_s2 = tot_s2 + 1 'january 01 2001
If UCase(Mid(ooo, ss, sslen + II)) = UCase(SSS3) Then tot_s3 = tot_s3 + 1 'january 01 2001
If UCase(Mid(ooo, ss, sslen + II)) = UCase(SSS4) Then tot_s4 = tot_s4 + 1 '23 june 2002
If UCase(Mid(ooo, ss, sslen + II)) = UCase(SSS5) Then tot_s5 = tot_s5 + 1 '23 june 2002
If UCase(Mid(ooo, ss, sslen + II)) = UCase(SSS6) Then tot_s6 = tot_s6 + 1 '23 june 2002
ForeColor = QBColor(Set_Fore) 'set color
Font.Bold = True
Font.Underline = True
'26 March 2003 try the below (seemed to work) Print Mid(ooo, ss, sslen);
' If Cmd(56) <> "PHOTO_DETAIL" Then Print Mid(ooo, ss, sslen);
' needed the original display for "C" context hi-liting.... put back
If Left(UCase(Cmd(77)), 16) = "CHARACTERPAUSE==" Then '03 January 2005
new_delay_sec = Val(Right(Cmd(77), Len(Cmd(77)) - 16))
tempss = Mid(ooo, ss, sslen) '03 January 2005
For temp1 = 1 To Len(tempss)
Print Left(tempss, 1);
tempss = Right(tempss, Len(tempss) - 1)
GoSub line_30300 '03 January 2005
Next temp1
Else
' Print ooo;
Print Mid(ooo, ss, sslen);
End If '03 January 2005
tot_print = tot_print + sslen
If extract_yes = "YES" Then
Print #ExtFile, Mid(ooo, ss, sslen);
End If
' If sscreen_saver = "Y" Then
'26 March 2003 deactivate the following if part of version ver=1.02b fix required
If sscreen_saver = "Y" And sscreen_saver = "N" Then
Font.Size = 24
ForeColor = QBColor(AltColor) 'make a different color here and below screen saver
' dsp_cnt = dsp_cnt + 1 'may 09 2001
'26 March 2003 dump the display count for now (skip the whole routine)
' with the dsp_cnt print and all what the hey anyway
' Print Mid(ooo, ss, sslen); " "; CStr(dsp_cnt); " "; 'may 09 2001
Print Mid(ooo, ss, sslen); " "; 'may 09 2001
Font.Size = Val(Cmd(2))
End If 'october 24 2000
ForeColor = QBColor(Def_Fore) 'default color
Font.Bold = False
Font.Underline = False
aaa = Mid(aaa, ss + sslen)
ooo = Mid(ooo, ss + sslen)
line_12610:
If Len(aaa) > 0 Then GoTo line_12500
GoTo line_12130 'no more data
GoTo line_14222
line_13000: 'january 18 2001
'below get rid of all trailing spaces
II = Len(aaa)
If Right(aaa, 1) = " " Then
aaa = Left(aaa, II - 1)
ooo = Left(ooo, II - 1)
GoTo line_13000
End If
line_13010: 'january 19 2001 see imbedded spaces in search string and replace them in xxx string
xxx = aaa + ""
' If zzz_cnt > 20929 Then
' tt1 = InputBox("testing prompt 13000c" + CStr(Len(aaa)) + " " + SSS1 + " " + match_flag, , , 4400, 4500) 'TESTING ONLY
' If tt1 = "X" Or tt1 = "x" Then
' GoTo End_32000
' End If 'testing only
' End If
If match_flag <> "YES" Then GoTo line_13070 'only required if match in line
If imbedded = "NO" Then GoTo line_13070 'only required if one has a imbedded space
If s1_imbed = "" Then GoTo line_13020
II = 1
line_13012:
JJ = InStr(II, aaa, SSS1)
If JJ = 0 Then GoTo line_13020
xxx = Left(aaa, JJ - 1) + s1_imbed + Mid(aaa, JJ + Len(SSS1) - 1)
II = JJ + 1
GoTo line_13012
line_13020:
If s2_imbed = "" Then GoTo line_13030
II = 1
line_13022:
JJ = InStr(II, aaa, SSS2)
If JJ = 0 Then GoTo line_13030
xxx = Left(aaa, JJ - 1) + s2_imbed + Mid(aaa, JJ + Len(SSS2) - 1)
II = JJ + 1
GoTo line_13022
line_13030:
If s3_imbed = "" Then GoTo line_13040
II = 1
line_13032:
JJ = InStr(II, aaa, SSS3)
If JJ = 0 Then GoTo line_13040
xxx = Left(aaa, JJ - 1) + s3_imbed + Mid(aaa, JJ + Len(SSS3) - 1)
II = JJ + 1
GoTo line_13032
'23 june 2002 add 4 thru 6 below
line_13040:
If s4_imbed = "" Then GoTo line_13050
II = 1
line_13042:
JJ = InStr(II, aaa, SSS4)
If JJ = 0 Then GoTo line_13050
xxx = Left(aaa, JJ - 1) + s4_imbed + Mid(aaa, JJ + Len(SSS4) - 1)
II = JJ + 1
GoTo line_13042
line_13050:
If s5_imbed = "" Then GoTo line_13060
II = 1
line_13052:
JJ = InStr(II, aaa, SSS5)
If JJ = 0 Then GoTo line_13060
xxx = Left(aaa, JJ - 1) + s5_imbed + Mid(aaa, JJ + Len(SSS5) - 1)
II = JJ + 1
GoTo line_13052
line_13060:
If s6_imbed = "" Then GoTo line_13070
II = 1
line_13062:
JJ = InStr(II, aaa, SSS6)
If JJ = 0 Then GoTo line_13070
xxx = Left(aaa, JJ - 1) + s6_imbed + Mid(aaa, JJ + Len(SSS6) - 1)
II = JJ + 1
GoTo line_13062
line_13070:
line_13620:
II = Len(aaa)
array_pos = array_pos + 1
If array_pos > 55 Then
'22 October 2004 xtemp = InputBox("error 13620 line too long=" + CStr(array_pos), "test", , xx1 - offset1, yy1 - offset2) '
frmproj2.Caption = "error 13620 line too long (use crop option) " + CStr(Len(aaa)) '22 October 2004
new_delay_sec = 1 '22 October 2004
GoSub line_30300 '22 October 2004
Beep '22 October 2004
II = 50 '22 October 2004
aaa = Left(aaa, 50) '22 October 2004
array_pos = 10 '22 October 2004 keep it from stopping on line too long errors
GoTo line_13635
End If
line_13625:
If II <= line_len + over_lap Then GoTo line_13630
line_13626:
tt = InStr(line_len, xxx, " ")
'if a - is going to split a word make sure that there are no nearby spaces below
line_13627:
If (tt = 0 Or tt > line_len + over_lap) And Mid(aaa, line_len - 1, 1) = " " Then tt = line_len - 1
If (tt = 0 Or tt > line_len + over_lap) And Mid(aaa, line_len - 2, 1) = " " Then tt = line_len - 2
If (tt = 0 Or tt > line_len + over_lap) And Mid(aaa, line_len - 3, 1) = " " Then tt = line_len - 3
If (tt = 0 Or tt > line_len + over_lap) And Mid(aaa, line_len - 4, 1) = " " Then tt = line_len - 4
line_13627a:
If tt = 0 Then GoTo line_13628
line_13627b:
If tt > line_len + over_lap Then GoTo line_13628
line_13627c:
array_aaa(array_pos) = " " + Left(aaa, tt - 1) + " "
array_ooo(array_pos) = " " + Left(ooo, tt - 1) + " "
aaa = Mid(aaa, tt)
ooo = Mid(ooo, tt)
xxx = Mid(xxx, tt) 'january 21 2001
GoTo line_13620
line_13628:
new_len = line_len
If match_flag = "NO" Then GoTo line_13628m
'ensure the break does not come in any of the hi-lite items...
'for each of the 3 search elements make sure there is no break
'in the middle use s1len s2len s3len values and the instr(?)
'to check for overlap
'if the hi-lite item less than 2 characters the break can never split it.
' new_len = line_len
If s1len < 2 Then GoTo line_13628d
III = line_len - s1len + 2
If III < 1 Then GoTo line_13628d 'should never happen
JJ = InStr(III, aaa, SSS1)
If JJ = 0 Then GoTo line_13628d 'no match found
If JJ > line_len Then GoTo line_13628d 'match found after break
' If JJ + s1len - 1 = line_len Then GoTo line_13628d '
' the above line was used when III above was calculated using II = line_len-s1len+1
new_len = JJ - 1
GoTo line_13628m
line_13628d:
If s2len < 2 Then GoTo line_13628h
III = line_len - s2len + 2
If III < 1 Then GoTo line_13628h 'should never happen
JJ = InStr(III, aaa, SSS2)
If JJ = 0 Then GoTo line_13628h 'no match found
If JJ > line_len Then GoTo line_13628h 'match found after break
new_len = JJ - 1
GoTo line_13628m
line_13628h:
If s3len < 2 Then GoTo line_13628i
III = line_len - s3len + 2
If III < 1 Then GoTo line_13628i 'should never happen
JJ = InStr(III, aaa, SSS3)
If JJ = 0 Then GoTo line_13628i 'no match found
If JJ > line_len Then GoTo line_13628i 'match found after break
new_len = JJ - 1
GoTo line_13628m
'23 june 2002 do 4 thru 6 below
line_13628i:
If s4len < 2 Then GoTo line_13628j
III = line_len - s4len + 2
If III < 1 Then GoTo line_13628j 'should never happen
JJ = InStr(III, aaa, SSS4)
If JJ = 0 Then GoTo line_13628j 'no match found
If JJ > line_len Then GoTo line_13628j 'match found after break
new_len = JJ - 1
GoTo line_13628m
line_13628j:
If s5len < 2 Then GoTo line_13628k
III = line_len - s5len + 2
If III < 1 Then GoTo line_13628k 'should never happen
JJ = InStr(III, aaa, SSS5)
If JJ = 0 Then GoTo line_13628k 'no match found
If JJ > line_len Then GoTo line_13628k 'match found after break
new_len = JJ - 1
GoTo line_13628m
line_13628k:
If s6len < 2 Then GoTo line_13628m
III = line_len - s6len + 2
If III < 1 Then GoTo line_13628m 'should never happen
JJ = InStr(III, aaa, SSS6)
If JJ = 0 Then GoTo line_13628m 'no match found
If JJ > line_len Then GoTo line_13628m 'match found after break
new_len = JJ - 1
line_13628m:
array_aaa(array_pos) = " " + Left(aaa, new_len) + "-"
array_ooo(array_pos) = " " + Left(ooo, new_len) + "-"
aaa = Mid(aaa, new_len + 1)
ooo = Mid(ooo, new_len + 1)
xxx = Mid(xxx, new_len + 1)
'
' xtemp = InputBox("testing prompt_=" + aaa + " " + CStr(new_len) + " " + CStr(cnt), "test", , 4400, 4500) '
' xtemp = InputBox("testing prompt=" + AllSearch(1) + "*" + ttt + " " + SSS1 + " " + SSS2 + " " + SSS3 + " " + CStr(zzz_cnt), "test", , 4400, 4500) '
' If UCase(xtemp) = "X" Then GoTo End_32000
GoTo line_13620
'line_13629:
' Print #ExtFile, Left(aaa, line_len); "-"
' temp2 = temp2 + 1
' aaa = Mid(aaa, line_len + 1)
' GoTo line_13620
line_13630:
array_aaa(array_pos) = " " + aaa + " "
array_ooo(array_pos) = " " + ooo + " "
line_13635:
If Left(array_aaa(1), 2) = " " Then
array_aaa(1) = Mid(array_aaa(1), 2) 'remove the extra space line 1 only
array_ooo(1) = Mid(array_ooo(1), 2) 'as 1 is already added at start
aaa = array_aaa(1) 'line broken into multiple parts start printing with first part
ooo = array_ooo(1)
array_prt = 1
End If
line_13640:
'back to the logic after 12120 line
GoTo line_12120
line_13999:
line_14222: 'january 15 2001
Return
No comments have been posted about This is the line wrap and highlight code from my search engine. see the matching flowcharts at:. Why not be the first to post a comment about This is the line wrap and highlight code from my search engine. see the matching flowcharts at:.