Search for text in editbox with 6 methods
This code shows how to build a search text on vfp editbox.
there is 6 methods to search string in an editbox
-by a loop with selSTart,selLength as legacy vfp method described in method1(code adapted from solution.app)-Click always for next found searched string
-by a search container class and a button to continue search --Click always for next found searched string
-by vfp dialog search ( as CTRL+F after giving the focus on edittbox) sys(1500) is used to do that.
-by adding a contextuel menu on editbox and invoking the dialog search by vfp system menu names.
-by using the native manu option _med_find
-by using a web method highlighting all occurences found.
in menu left button can use a contextuel menu to invoke each method.
i used two classes (container embedding some controls) and ysearch class coded as below the prg.
open any txt file (even big one) and start.for the demo i used a web txt file download at start(internet connected)
Infortunatly vfp editbox is monocolor (not a richtext control).that why can highlight one string found at once only.this can be done on richtext (see previous pots) or web page(method 6).
*Note:for editor limitation add to this code the 2 classes below(all in one prg named ysearch.prg)
[post 251]
Click on code to select [then copy] -click outside to deselect
*1* created on thursday 21 of december 2017
*Note:for editor limitation add to this code the 2 classes below(all in one prg)
if !_vfp.startmode=0
on shutdown quit
endi
_screen.windowstate=1
publi m.yrep
m.yrep=addbs(justpath(sys(16,1)))
set defa to (yrep)
publi oform
oform=newObject("ysearches")
oform.show
read events
retu
*
DEFINE CLASS ysearches AS form
DataSession = 2
AlwaysOnBottom=.t.
BorderStyle = 3
Height = 567
Width = 642
ShowWindow = 2
AutoCenter = .T.
Caption = "Search in text with 4 methods"
HelpContextID = 1231527
BackColor = RGB(212,210,208)
yenablecm = .F.
Name = "form1"
ADD OBJECT ycnt AS ycnt WITH ;
Anchor = 768, ;
Top = 407, ;
Left = 30, ;
Width = 541, ;
Height = 152, ;
Name = "yCNT"
ADD OBJECT ysearch1 AS ysearch with ;
anchor=768, ;
backcolor=rgb(255,255,255), ;
backstyle=1, ;
borderwidth=0, ;
left=0, ;
top=0, ;
name="ysearch1"
ADD OBJECT cmdopen AS commandbutton WITH ;
Top = 5, ;
Left = 492, ;
Height = 23, ;
Width = 72, ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Anchor = 768, ;
Caption = "\<Open File...", ;
TabIndex = 21, ;
Name = "cmdOpen"
ADD OBJECT edttext AS editbox WITH ;
FontBold = .F., ;
FontSize = 9, ;
Anchor = 15, ;
Height = 295, ;
HideSelection = .F., ;
Left = 33, ;
TabIndex = 3, ;
Top = 56+5, ;
Width = 601, ;
BackColor = RGB(255,255,234), ;
SelectedForeColor = RGB(255,255,255), ;
SelectedBackColor = RGB(0,0,160), ;
Name = "edtText"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 24, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "?", ;
Height = 40, ;
Left = 600, ;
MousePointer = 15, ;
Top = -2, ;
Width = 22, ;
ForeColor = RGB(128,0,64), ;
Name = "Label1"
ADD OBJECT ydummy AS commandbutton WITH ;
AutoSize = .T., ;
Top = 3, ;
Left = 393, ;
Height = 27, ;
Width = 98, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Search String", ;
MousePointer = 15, ;
Style = 0, ;
Visible = .T., ;
BackColor = RGB(128,255,0), ;
Name = "ydummy"
ADD OBJECT command1 AS commandbutton WITH ;
AutoSize = .T., ;
Top = 3, ;
Left = 263, ;
Height = 27, ;
Width = 70, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Continue", ;
MousePointer = 15, ;
Style = 0, ;
Visible = .T., ;
BackColor = RGB(128,255,0), ;
Name = "Command1"
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
FontSize = 8, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "", ;
Height = 16, ;
Left = 268, ;
Top = 30, ;
Width = 2, ;
Name = "Label2"
ADD OBJECT command2 AS commandbutton WITH ;
AutoSize = .F., ;
Top = 55, ;
Left = -17, ;
Height = 299, ;
Width = 45, ;
FontSize = 48, ;
Anchor = 768, ;
Picture = home(1)+"graphics\icons\misc\lighton.ico", ;
Caption = "", ;
MousePointer = 15, ;
PicturePosition = 13, ;
PictureMargin = 10, ;
BackColor = RGB(255,0,0), ;
Alignment = 2, ;
Name = "Command2"
*-- count the number of words, characters, and hard returns in the string passed as a parameter.
PROCEDURE count
LPARAMETERS cString
THISFORM.WaitMode(.T.)
#DEFINE MSG_LOC "Generating statistics for the file. Press Enter to stop."
WAIT WINDOW MSG_LOC NOWAIT NOCLEAR
LOCAL lnWords, lnParas, llWord, lnChars
#DEFINE ALPHA_LOC "ABCDEFGHIJKLMNOPQRSTUVWXYZ."
#DEFINE CR CHR(13)
#DEFINE TAB CHR(9)
lnWords = 0
lnParas = 0
llWord = .F.
lnChars = LEN(cString)
SYS(2002) && turn the cursor off
FOR i = 1 TO lnChars
IF INKEY() = 13
WAIT CLEAR
THISFORM.WaitMode(.F.)
THIS.ycnt.txtCharacters.Value = ""
THIS.ycnt.txtWords.Value = ""
THIS.ycnt.txtParagraphs.Value = ""
SYS(2002,1)
RETURN
ENDIF
lcLetter = UPPER(SUBSTR(cString, i, 1))
IF lcLetter$ALPHA_LOC
llWord = .T.
LOOP
ENDIF
IF lcLetter = CR
lnParas = lnParas + 1
ENDIF
IF llWord AND INLIST(lcLetter, " ", TAB, CR)
lnWords = lnWords + 1
llWord = .F.
ENDIF
ENDFOR
* In case the last word is not followed by a white character
IF llWord
lnWords = lnWords + 1
ENDIF
THISFORM.ycnt.txtCharacters.Value = lnChars
THISFORM.ycnt.txtWords.Value = lnWords
THISFORM.ycnt.txtParagraphs.Value = lnParas
WAIT CLEAR
THISFORM.WaitMode(.F.)
SYS(2002,1)
ENDPROC
PROCEDURE waitmode
LPARAMETERS tlWaitMode
lnMousePointer = IIF(tlWaitMode, 11, 0)
thisform.MousePointer = lnMousePointer
thisform.SetAll('MousePointer', lnMousePointer)
thisform.label1.mousepointer=15
ENDPROC
PROCEDURE ysearchEdt
parameters xtext &&public
IF EMPTY(xText)
#DEFINE EMPTY_LOC "Please specify some text to search for."
WAIT WINDOW EMPTY_LOC TIMEOUT 1.5
RETURN .f.
ENDIF
*wait window trans(occurs(allt(xtext),thisform.edtText.value))+" occurs of "+allt(xtext) timeout 2
thisform.label2.caption=trans(occurs(allt(xtext),thisform.edtText.value))+" occurs of ["+allt(xtext)+'] found.'
LOCAL loEDT, i, llFound, lnStart, lnLen, lnChoice, llKeepLooking, llCaseSensitive
llFound = .F.
llCaseSensitive = .f.
* Search for the first instance of the text
*-------------------------------------------
loEDT = THISform.edtText
lnLen = LEN(ALLTRIM(xText))
lnStart = loEDT.SelStart
* See if value is already selected
IF loEDT.SelText = ALLTRIM(xText) OR ;
(!llCaseSensitive AND (UPPER(loEDT.SelText) = UPPER(ALLTRIM(xText))))
lnStart = lnStart + 1
ENDIF
THISFORM.LockScreen = .T.
loEDT.HideSelection = .T.
THISFORM.WaitMode(.T.)
llKeepLooking = .T.
DO WHILE llKeepLooking
FOR i = lnStart TO LEN(loEDT.Value)
loEDT.SelStart = i
loEDT.SelLength = lnLen
IF loEDT.SelText = ALLTRIM(xText) OR ;
(!llCaseSensitive AND ;
(UPPER(loEDT.SelText) = UPPER(ALLTRIM(xText))))
llFound = .T.
llKeepLooking = .F.
EXIT
ENDIF
ENDFOR
IF !llFound
#DEFINE NOTFOUND_LOC "Search string not found." + chr(13) ;
+ "Do you want to continue searching from the beginning?"
#DEFINE CAP_LOC "Not Found"
lnChoice=MESSAGEBOX(NOTFOUND_LOC,64+0+4,CAP_LOC)
IF lnChoice = 6 && Yes
llKeepLooking = .T.
lnStart = 0
ELSE
llKeepLooking = .F.
ENDIF
ENDIF
ENDDO
loEDT.HideSelection = .F.
THISFORM.LockScreen = .F.
THISFORM.WaitMode(.F.)
ENDPROC
PROCEDURE ym0
with thisform
.setall("visible",.t.)
.label2.caption=""
endwith
ENDPROC
PROCEDURE ym1
with thisform
.setall("visible",.t.)
.ysearch1.visible=.f.
.command1.visible=.f.
.ydummy.visible=.f.
.label2.caption=""
endwith
ENDPROC
PROCEDURE ym2
with thisform
.setall("visible",.t.)
.ycnt.visible=.f.
.ysearch1.visible=.t.
.command1.visible=.t.
.ydummy.visible=.f.
.label2.caption=""
endwith
ENDPROC
PROCEDURE ym3
with thisform
.setall("visible",.t.)
.ycnt.visible=.f.
.ysearch1.visible=.f.
.command1.visible=.f.
.ydummy.visible=.t.
.label2.caption=""
.refresh
endwith
ENDPROC
PROCEDURE ym4
with thisform
.setall("visible",.t.)
.ycnt.visible=.f.
.ysearch1.visible=.f.
.command1.visible=.f.
.ydummy.visible=.f.
.label2.caption=""
.refresh
endwith
thisform.ycnt.check1.enabled=.t.
wait window "Select search in contextuel menu" timeout 0.5
thisform.edtText.setfocus()
thisform.edtText.rightclick()
ENDPROC
PROCEDURE ym5
with thisform
.setall("visible",.t.)
.ycnt.visible=.f.
.ysearch1.visible=.f.
.command1.visible=.f.
.ydummy.visible=.f.
.label2.caption=""
.refresh
.edtText.setFocus
endwith
doevent
sys(1500,"_med_find","_medit")
endproc
procedure ym6
local m.x
m.x=inputbox("String to search","","over")
if empty(m.x)
return .f.
endi
local m.myvar
text to m.myvar textmerge pretext 7 noshow
<p style="padding:20px;">
<<thisform.edtText.value>>
</p>
endtext
local m.nOccurs
m.nOccurs=occurs(m.x,m.myvar)
m.myvar=strtran(m.myvar,chr(13),"<br>")
m.myvar=strtran(m.myvar,m.x,"<span style='background-color:lime;'>"+m.x+ "</span>")
declare integer BringWindowToTop in user32 integer HNWD
local apie
apie=newObject("internetexplorer.application")
with apie
.navigate("about:blank")
inke(1)
with .document
.open()
.write(m.myvar)
.close()
endwith
.toolbar=0
.menubar=0
.statusbar=0
.width=800
.height=600
.top=50
.left=(sysmetric(1)-.width)/2
bringwindowtotop(.hwnd)
inke(2)
.document.title=trans(m.noccurs)+" occurences of string ["+m.x +" ] found- lime highlighed-"
.document.body.style.background="bisque"
.visible=.t.
endwith
endproc
PROCEDURE Init
this.setall('fontsize',9)
this.edtText.fontsize=10
this.label1.fontsize=24
****************
*for demo download a web big string
local m.lcURL,m.lcdest
m.lcDest=m.yrep+"book.txt"
if ! file(m.lcdest)
m.lcURl="http://www.fullbooks.com/Les-Miserables-by-Victor-Hugo-trans-Isabel-F1.html"
#Define OLECMDID_SAVEAS 4
#Define OLECMDEXECOPT_DONTPROMPTUSER 2
Local apie
apie = Createobject('internetexplorer.application')
With apie
.Navigate(m.lcUrl)
Do While.readystate#4 &&pass the transitionning (can put 5 sec as inke(5)).
Enddo
Inke(1)
apie.ExecWB(OLECMDID_SAVEAS ,OLECMDEXECOPT_DONTPROMPTUSER,m.yrep+"book.txt","") &&there is a bug in IE11 the dialog shows always in contary of the command!
.Quit
Endwith
endi
thisform.edtText.value=filetostr(m.yrep+"book.txt")
******************************
This.count(This.edtText.Value)
ENDPROC
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE ycnt.Init
with this
.left=(.parent.width-.width)/2
endwith
ENDPROC
PROCEDURE cmdopen.Destroy
IF SELECT("ycurs") > 0
USE IN ycurs
ENDIF
ENDPROC
PROCEDURE cmdopen.Click
try
use in select("ycurs")
catch
endtry
CREATE CURSOR ycurs (filename c(60),mem m)
APPEND BLANK
REPLACE ycurs.FileName WITH GETFILE("TXT")
IF EMPTY(ycurs.FileName)
RETURN
ENDIF
SELECT ycurs
APPEND MEMO mem FROM (ycurs.FileName) OVERWRITE
THIS.Parent.edtText.ControlSource = "ycurs.mem"
this.parent.label2.caption=""
THIS.Parent.Refresh
THIS.Parent.ycnt.cboSearchString.Enabled = .T.
THIS.Parent.ycnt.lblText.Enabled = .T.
THISFORM.Count(THIS.Parent.edtText.Value)
ENDPROC
PROCEDURE edttext.LostFocus
IF !EMPTY(THIS.Value)
THIS.Parent.ycnt.cboSearchString.Enabled = .T.
THIS.Parent.ycnt.lblText.Enabled = .T.
ENDIF
ENDPROC
PROCEDURE edttext.RightClick
if thisform.ycnt.check1.value=0
return .f.
endi
SET COLOR OF SCHEME 1 TO N+/w*,B+/W+*,,,,G/BG+
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL() Color Scheme 1
Define Bar _Med_find Of raccourci Prompt "Rec\<hercher..." ;
KEY CTRL+F, "Ctrl+F" ;
PICTRES _Med_find ;
MESSAGE "Recherche le texte spécifié"
Define Bar _Med_redo Of raccourci Prompt "\<Rétablir" ;
KEY CTRL+R, "Ctrl+R" ;
PICTRES _Med_redo ;
MESSAGE "Rétablit la dernière opération annulée"
Define Bar _Med_undo Of raccourci Prompt "\<Annuler" ;
KEY CTRL+Z, "Ctrl+Z" ;
PICTRES _Med_undo ;
MESSAGE "Annule la dernière modification"
Define Bar _Med_paste Of raccourci Prompt "C\<oller" ;
KEY CTRL+V, "Ctrl+V" ;
PICTRES _Med_paste ;
MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
Define Bar _Med_copy Of raccourci Prompt "Co\<pier" ;
KEY CTRL+c, "Ctrl+C" ;
PICTRES _Med_copy ;
MESSAGE "Copie la sélection et la place dans le Presse-papiers"
Define Bar _Med_cut Of raccourci Prompt "\<Couper" ;
KEY CTRL+X, "Ctrl+X" ;
PICTRES _Med_cut ;
MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
Define Bar _Med_slcta Of raccourci Prompt "Sélec\<tionner tout" ;
KEY CTRL+A, "Ctrl+A" ;
PICTRES _Med_slcta ;
MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
Activate Popup raccourci
*can disable an item menu by "\" before it
ENDPROC
PROCEDURE label1.Click
local m.myvar
text to m.myvar pretext 7 noshow
This code shows how to build a search text on vfp editbox.
there is 6 methods to search string in an editbox
-by a loop with selSTart,selLength as legacy vfp method described in method1(code adapted from solution.app)-Click always for next found searched string
-by a search container class and a button to continue search --Click always for next found searched string
-by vfp dialog search ( as CTRL+F after giving the focus on edittbox) sys(1500) is used to do that.
-by adding a contextuel menu on editbox and invoking the dialog search by vfp system menu names.
-by using the native manu option _med_find
-by using a web method highlighting all occurences found.
in menu left button can use a contextuel menu to invoke each method.
i used two classes (container embedding some controls) and ysearch class coded as below the prg.
open any txt file (even big one) and start.for the demo i used a web txt file download at start(internet connected)
Infortunatly vfp editbox is monocolor (not a richtext control).that why can highlight one string found at once only.this can be done on richtext (see previous pots) or web page(method 6).
*Note:for editor limitation add to this code the 2 classes below(all in one prg named ysearch.prg)
endtext
local oshell
oShell = Createobject('WScript.Shell')
oShell.Popup(m.myvar,0, 'Summary help', 0+32+4096)
oshell=null
ENDPROC
PROCEDURE ydummy.Click
thisform.edtText.setfocus
SET COLOR OF SCHEME 1 TO N+/w*,B+/W+*,,,,G/BG+
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL() Color Scheme 1
Define Bar _Med_find Of raccourci Prompt "Rec\<hercher..." ;
KEY CTRL+F, "Ctrl+F" ;
PICTRES _Med_find ;
MESSAGE "Recherche le texte spécifié"
Activate Popup raccourci
ENDPROC
PROCEDURE command1.Click
if !empty(thisform.ysearch1.text1.value) and ! empty(thisform.edtText.value)
thisform.ysearchEdt(thisform.ysearch1.text1.value)
else
wait window "type a text to search or fill the editbox from txt file!" timeout 1.2
endi
ENDPROC
PROCEDURE command2.Click
SET COLOR OF SCHEME 1 TO N+/w*,B+/W+*,,,,G/BG+
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL() Color Scheme 1
DEFINE BAR 1 OF raccourci PROMPT "All Methods"
DEFINE BAR 2 OF raccourci PROMPT "Method1" ;
PICTURE home(1)+"graphics\icons\misc\misc15.ico"
DEFINE BAR 3 OF raccourci PROMPT "Method2" ;
PICTURE home(1)+"graphics\icons\misc\circ1.ico"
DEFINE BAR 4 OF raccourci PROMPT "Method3" ;
PICTURE home(1)+"graphics\icons\misc\circ2.ico"
DEFINE BAR 5 OF raccourci PROMPT "Method4" ;
PICTURE home(1)+"graphics\icons\misc\circ3.ico"
DEFINE BAR 6 OF raccourci PROMPT "Method5" ;
PICTURE home(1)+"graphics\icons\misc\misc14.ico"
DEFINE BAR 7 OF raccourci PROMPT "Method web" ;
PICTURE home(1)+"graphics\icons\misc\misc15.ico"
ON SELECTION BAR 1 OF raccourci _screen.activeform.ym0()
ON SELECTION BAR 2 OF raccourci _screen.activeform.ym1()
ON SELECTION BAR 3 OF raccourci _screen.activeform.ym2()
ON SELECTION BAR 4 OF raccourci _screen.activeform.ym3()
ON SELECTION BAR 5 OF raccourci _screen.activeform.ym4()
ON SELECTION BAR 6 OF raccourci _screen.activeform.ym5()
ON SELECTION BAR 7 OF raccourci _screen.activeform.ym6()
ACTIVATE POPUP raccourci
ENDPROC
ENDDEFINE
*
*-- EndDefine: ysearches
Click on code to select [then copy] -click outside to deselect
*1.2*
*add these 2 classes to the code above (all in one prg)
DEFINE CLASS ycnt AS container
Anchor = 768
Top = 407
Left = 30
Width = 541
Height = 152
Name = "yCNT"
ADD OBJECT shape4 AS shape WITH ;
Top = 11, ;
Left = 7, ;
Height = 114, ;
Width = 231, ;
BackStyle = 0, ;
SpecialEffect = 0, ;
Name = "Shape4"
ADD OBJECT shape2 AS shape WITH ;
Top = 11, ;
Left = 252, ;
Height = 114, ;
Width = 95, ;
BackStyle = 0, ;
SpecialEffect = 0, ;
Name = "Shape2"
ADD OBJECT shape1 AS shape WITH ;
Top = 9, ;
Left = 358, ;
Height = 114, ;
Width = 135, ;
BackStyle = 0, ;
SpecialEffect = 0, ;
Name = "Shape1"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 1, ;
Caption = " \<Counts ", ;
Height = 15, ;
Left = 366, ;
Top = 4, ;
Width = 41, ;
TabIndex = 13, ;
Name = "Label1"
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 1, ;
Caption = " Format \<Text ", ;
Height = 15, ;
Left = 263, ;
Top = 4, ;
Width = 64, ;
TabIndex = 9, ;
Name = "Label2"
ADD OBJECT cmdproper AS commandbutton WITH ;
Top = 78, ;
Left = 265, ;
Height = 23, ;
Width = 72, ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Caption = "\<Initial Caps", ;
TabIndex = 12, ;
Name = "cmdProper"
ADD OBJECT cmdlower AS commandbutton WITH ;
Top = 49, ;
Left = 265, ;
Height = 23, ;
Width = 72, ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Caption = "\<lowercase", ;
TabIndex = 11, ;
Name = "cmdLower"
ADD OBJECT cmdupper AS commandbutton WITH ;
Top = 21, ;
Left = 265, ;
Height = 23, ;
Width = 72, ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Caption = "\<UPPERCASE", ;
TabIndex = 10, ;
Name = "cmdUpper"
ADD OBJECT label3 AS label WITH ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 1, ;
Caption = " Fi\<nd ", ;
Height = 15, ;
Left = 24, ;
Top = 5, ;
Width = 28, ;
TabIndex = 4, ;
Name = "Label3"
ADD OBJECT txtwords AS textbox WITH ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 0, ;
Height = 23, ;
Left = 426, ;
ReadOnly = .T., ;
TabIndex = 17, ;
TabStop = .F., ;
Top = 40, ;
Width = 51, ;
Name = "txtWords"
ADD OBJECT lblcharacters AS label WITH ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 0, ;
Caption = "Characters:", ;
Height = 15, ;
Left = 365, ;
Top = 21, ;
Width = 56, ;
TabIndex = 14, ;
Name = "lblCharacters"
ADD OBJECT lblparagraphs AS label WITH ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 0, ;
Caption = "Paragraphs:", ;
Height = 15, ;
Left = 365, ;
Top = 64, ;
Width = 59, ;
TabIndex = 18, ;
Name = "lblParagraphs"
ADD OBJECT cmdrefresh AS commandbutton WITH ;
Top = 90, ;
Left = 365, ;
Height = 23, ;
Width = 72, ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Caption = "\<Refresh", ;
TabIndex = 20, ;
Name = "cmdRefresh"
ADD OBJECT txtcharacters AS textbox WITH ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 0, ;
Height = 23, ;
Left = 426, ;
ReadOnly = .T., ;
TabIndex = 15, ;
TabStop = .F., ;
Top = 18, ;
Width = 51, ;
Name = "txtCharacters"
ADD OBJECT txtparagraphs AS textbox WITH ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 0, ;
Height = 23, ;
Left = 426, ;
ReadOnly = .T., ;
TabIndex = 19, ;
TabStop = .F., ;
Top = 62, ;
Width = 51, ;
Name = "txtParagraphs"
ADD OBJECT lblwords AS label WITH ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 0, ;
Caption = "Words:", ;
Height = 15, ;
Left = 365, ;
Top = 43, ;
Width = 36, ;
TabIndex = 16, ;
Name = "lblWords"
ADD OBJECT lbltext AS label WITH ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
BackStyle = 0, ;
Caption = "Text to \<search for:", ;
Height = 15, ;
Left = 18, ;
Top = 19, ;
Width = 88, ;
TabIndex = 5, ;
Name = "lblText"
ADD OBJECT cmdfind AS commandbutton WITH ;
Top = 61, ;
Left = 20, ;
Height = 23, ;
Width = 72, ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Caption = "\<Find", ;
Enabled = .F., ;
TabIndex = 7, ;
Name = "cmdFind"
ADD OBJECT chkcase AS checkbox WITH ;
Top = 90, ;
Left = 19, ;
Height = 17, ;
Width = 143, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Case Sensitive Search", ;
Value = .T., ;
Enabled = .F., ;
TabIndex = 8, ;
Name = "chkCase"
ADD OBJECT cbosearchstring AS combobox WITH ;
FontBold = .F., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Height = 23, ;
Left = 20, ;
TabIndex = 6, ;
Top = 34, ;
Width = 209, ;
Name = "cboSearchString"
ADD OBJECT check1 AS checkbox WITH ;
Top = 131, ;
Left = 12, ;
Height = 17, ;
Width = 195, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Enable/disable contectuel menu", ;
Value = 1, ;
Name = "Check1"
PROCEDURE Init
with this
.left=(.parent.width-.width)/2
endwith
ENDPROC
PROCEDURE cmdproper.Click
LOCAL lnOldStart, lnOldLength, lo
lo = THISform.edtText
lnOldStart = lo.SelStart
lnOldLength = lo.SelLength
if lnOldLength=0
wait window ("select first text !") nowait
endi
lo.SelText = PROPER(lo.SelText)
lo.SelStart = lnOldStart
lo.SelLength = lnOldLength
ENDPROC
PROCEDURE cmdlower.Click
LOCAL lnOldStart, lnOldLength, lo
lo = THISform.edtText
lnOldStart = lo.SelStart
lnOldLength = lo.SelLength
if lnOldLength=0
wait window ("select first text !") nowait
endi
lo.SelText = LOWER(lo.SelText)
lo.SelStart = lnOldStart
lo.SelLength = lnOldLength
ENDPROC
PROCEDURE cmdupper.Click
LOCAL lnOldStart, lnOldLength, lo
lo = THISform.edtText
lnOldStart = lo.SelStart
lnOldLength = lo.SelLength
if lnOldLength=0
wait window ("select first text !") nowait
endi
lo.SelText = UPPER(lo.SelText)
lo.SelStart = lnOldStart
lo.SelLength = lnOldLength
ENDPROC
PROCEDURE cmdrefresh.Click
IF !EMPTY(THISFORM.edtText.Value)
THISFORM.Count(THISFORM.edtText.Value)
ELSE
THIS.Parent.txtCharacters.Value = 0
THIS.Parent.txtWords.Value = 0
THIS.Parent.txtParagraphs.Value = 0
ENDIF
ENDPROC
PROCEDURE cmdfind.Click
LOCAL loCBO, loEDT, i, llFound, lnStart, lnLen, lnChoice, llKeepLooking, llCaseSensitive
llFound = .F.
llCaseSensitive = THIS.parent.chkCase.Value
* Make sure there is something to search for
*-------------------------------------------
loCBO = THIS.Parent.cboSearchString
IF EMPTY(loCBO.Text)
#DEFINE EMPTY_LOC "Please specify some text to search for."
WAIT WINDOW EMPTY_LOC TIMEOUT 1.5
loCBO.SetFocus
RETURN
ENDIF
thisform.label2.caption=trans(occurs(ALLTRIM(loCBO.Text),thisform.edtText.value))+" occurs of ["+ALLTRIM(loCBO.Text)+'] found.'
* Search for the first instance of the text
*-------------------------------------------
loEDT = THISform.edtText
lnLen = LEN(ALLTRIM(loCBO.Text))
lnStart = loEDT.SelStart
* See if value is already selected
IF loEDT.SelText = ALLTRIM(loCBO.Text) OR ;
(!llCaseSensitive AND (UPPER(loEDT.SelText) = UPPER(ALLTRIM(loCBO.Text))))
lnStart = lnStart + 1
ENDIF
THISFORM.LockScreen = .T.
loEDT.HideSelection = .T.
THISFORM.WaitMode(.T.)
llKeepLooking = .T.
DO WHILE llKeepLooking
FOR i = lnStart TO LEN(loEDT.Value)
loEDT.SelStart = i
loEDT.SelLength = lnLen
IF loEDT.SelText = ALLTRIM(loCBO.Text) OR ;
(!llCaseSensitive AND ;
(UPPER(loEDT.SelText) = UPPER(ALLTRIM(loCBO.Text))))
llFound = .T.
llKeepLooking = .F.
EXIT
ENDIF
ENDFOR
IF !llFound
#DEFINE NOTFOUND_LOC "Search string not found." + chr(13) ;
+ "Do you want to continue searching from the beginning?"
#DEFINE CAP_LOC "Not Found"
lnChoice=MESSAGEBOX(NOTFOUND_LOC,64+0+4,CAP_LOC)
IF lnChoice = 6 && Yes
llKeepLooking = .T.
lnStart = 0
ELSE
llKeepLooking = .F.
ENDIF
ENDIF
ENDDO
loEDT.HideSelection = .F.
THISFORM.LockScreen = .F.
THISFORM.WaitMode(.F.)
ENDPROC
PROCEDURE cbosearchstring.Valid
IF !EMPTY(THIS.Text)
FOR i = 1 TO THIS.ListCount
IF THIS.List(i) = THIS.Text
RETURN
ENDIF
ENDFOR
THIS.AddItem(THIS.Text)
ENDIF
ENDPROC
PROCEDURE cbosearchstring.InteractiveChange
IF !EMPTY(THIS.Text)
THIS.Parent.cmdFind.Enabled = .T.
THIS.Parent.chkCase.Enabled = .T.
ELSE
THIS.Parent.cmdFind.Enabled = .F.
THIS.Parent.chkCase.Enabled = .F.
ENDIF
ENDPROC
ENDDEFINE
*
*-- EndDefine: ycnt
*****************************************
DEFINE CLASS ysearch AS container
Top = 0
Left =0
Width = 258
Height = 40
BackStyle = 1
Backcolor=rgb(255,255,255)
BorderWidth = 0
Name = "ysearch"
ADD OBJECT image1 AS image WITH ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 32, ;
Left = 2, ;
Top = 2, ;
Width = 32, ;
Name = "Image1"
ADD OBJECT text1 AS textbox WITH ;
autocomplete=1,;
BackStyle = 0, ;
BorderStyle = 0, ;
Height = 27, ;
Left = 33, ;
Top = 4, ;
Width = 216, ;
Name = "Text1"
ADD OBJECT label1 AS label WITH ;
FontSize = 10, ;
BackStyle = 1, ;
BorderStyle = 0, ;
Caption = " Search for. ..", ;
Height = 26, ;
Left = 26, ;
Top = 4, ;
Width = 194, ;
ForeColor = RGB(209,209,209), ;
Name = "Label1"
PROCEDURE Init
with this
.backstyle=1
.borderwidth=1
.backcolor=rgb(255,255,255)
.left=4
.top=4
.text1.setfocus
endwith
ENDPROC
PROCEDURE text1.valid
If !Empty(This.Value)
This.Parent.label1.visible=.f.
Else
This.Parent.label1.visible=.t.
Endif
thisform.command1.click
ENDPROC
PROCEDURE image1.Click
this.parent.text1.enabled=.t.
This.Parent.text1.SetFocus
ENDPROC
PROCEDURE image1.Init
with this
.mousepointer=15
.backstyle=1
.stretch=2
.width=25
.height=25
.top=4
.left=4
endwith
*this 3 images of the search icon png appearing randomly
local m.myvar1,m.myvar2,m.myvar3
TEXT TO m.myvar PRETEXT 7 noshow
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAC1klEQVRYhbXWT2geRRjH8U+ClCJSRIpIkawtCD0olFChNRVde7B60YsehBz0ontT8aYgpagUoYKgK95DpaJCEUVFB7Wo4J+WEjyFmJVQihQpJRQRCR5mXjJJ3n3z7mve32mf2Zl5vrsz88xvQovKqtmPJzCDKdyAFSwg4Eyoiytt44fVRJ/EU3gTj2FywNi/8RaOh7q4vi0AZdUcw2nc3GGO3/BoqIuF/wVQVs0j+Bg7svdfYA4XcR234RCewv6s3yXMhLpYGgmgrJp9OI9d2YSzoS6+7jeorJpJPIeT4t6AnxPEP10Aemv89obkM23JIdTFaqiLU3gc/6bmg3i2S3KYKKtmGr+keBVlqItvh52grJoTeDmD39vlL0xiNovPdkme9Dr+TM978ECXwZO4N4tPd0wuHcEzWdP9XQFuz+JfuwIknc+e93UF2JnF10YEyNf8pq4AK1l8y4gA+UestPZqAVjK4ukRAe7Jnhe7AnyfxbNtHdtUVs0u8dLq6buuAHPi+Ydj6T7ooles3R2X0FrA+gKEupjHR1nbXFk1B4YZXFbN02JJ7unVrqW4dxfsEY/Sran9Gp7B+6Eu+iW+EcfxgrVyvog7Q12sbhqwFUCa9Ag+s/4YXcAHmMdV8TY8jCcz2Fyvhbp4aSSABHEIH4oldVgtW1/M5sWjeE5ckquDBq9zPKEufsTdeEd0PIN0Bc9jL97N2u8SPcOL+CE5rFZtsmQ9lVWzW7Rl94mecIdoShbxFT7pWbHkD35P/TZqCUdDXfStD60AXVVWzU+iJ+inP8RrfhPEINPZVecGvJtCSM5rbAAncXkIiDvGAhDq4jIexl9bQHyTQ2znHxDq4gIeEmvGIIjQOx3btglzlVVzEJ8bfL0v4PBYABLENL7cAuK9sQEkiAMJYndLl+Vt3QMblfbEUWuueaN2jhUgQVwUnfJyn9dnx7oEudKufwMPiqfvU1T/Ae+yy12f0SBjAAAAAElFTkSuQmCC
endtext
text to m.myvar1 pretext 7 noshow
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAC1UlEQVRYhbXWTWgdVRjG8V+CDEWkiBSRImFaELpQKKFCaxRHu7C60Y0uhCx0o+5U3ClIEZVSqCAo4j5UKioUUVQ0oxYV/GgpwVWIg4RSpEgpocggwcU5l5zk3rm555r7rOY9cz7+M+ec932mdKipigN4AnOYwQ1YwzIWcaas2ytd40fV1ICFZ/AWHsP0kLH/4G0cL+v2+o4ANFVxDKdxc8Ycv+PRsm6X/xdAUxWP4BMUyfsvsYCLuI7bcBhP4UDS7xLmyrptxgJoqmI/zmN3MuF8WbffDBrUVMU0nscJ4WzALxGizQHo7fE7Wxaf61ocyrpdL+v2FB7Hv7H5EJ7NWRymmqqYxa8xXscDZd1+N+oETVW8hlcS+H05f2Ea80l8NmfxqDfxV3zeiypn8DTuSeLTmYuLV/BM0nR/LsDtSfxbLkDU+eR5fy7AriS+NiZAuuc35QKsJfEtYwKkH7HW2asDoEni2TEB7k6eV3IBfkji+a6OXWqqYrdQtHr6PhdgQbj/cCzWgxy9aqN2XEJnAhsIUNbtEj5O2haaqjg4yuCmKp4WUnJPr+em4l4t2CtcpVtj+zU8gw/Kun++pipuxHG8aCOdr+COsm7X+wZsBxAnvRef23yNLuBDLOGqUA2P4MkENtUbZd2+PBZAhDiMj4SUOqpWbU5mS8JVPCdsydVhgzc5nrJuf8JdeFdwPMN0BS9gH95L2u8UPMNL+DE6rE71WbKemqrYI9iy+wRPWAimZAVf49OeFYv+4I/Yr28qHC3rdmB+6ATIVVMVPwueYJD+FMp8H8Qw05mrc0PezWAxOq+JAZzA5REgyokAlHV7GQ/j720gvk0hdvIPKOv2Ah4ScsYwiMXe7dixQ5iqqYpD+MLw8r6MIxMBiBCz+GobiPcnBhAhDkaIPR1dVnf0DGxVPBNHbbjmrdo1UYAIcVFwyqsDXp+d6Bakiqf+JB4Ubt9neO4/LujK+EKJZ8QAAAAASUVORK5CYII=
endtext
text to m.myvar2 pretext 7 noshow
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAC1UlEQVRYhbXWTWgdVRjG8V+CDEWkiBSRImFaELpQKKFCaxRHu7C60Y0uhCx0o+5U3ClIEZVSqCAo4j5UKioUUVQ0oxYV/GgpwVWIg4RSpEgpocggwcU5l5zk3rm555r7rOY9cz7+M+ec932mdKipigN4AnOYwQ1YwzIWcaas2ytd40fV1ICFZ/AWHsP0kLH/4G0cL+v2+o4ANFVxDKdxc8Ycv+PRsm6X/xdAUxWP4BMUyfsvsYCLuI7bcBhP4UDS7xLmyrptxgJoqmI/zmN3MuF8WbffDBrUVMU0nscJ4WzALxGizQHo7fE7Wxaf61ocyrpdL+v2FB7Hv7H5EJ7NWRymmqqYxa8xXscDZd1+N+oETVW8hlcS+H05f2Ea80l8NmfxqDfxV3zeiypn8DTuSeLTmYuLV/BM0nR/LsDtSfxbLkDU+eR5fy7AriS+NiZAuuc35QKsJfEtYwKkH7HW2asDoEni2TEB7k6eV3IBfkji+a6OXWqqYrdQtHr6PhdgQbj/cCzWgxy9aqN2XEJnAhsIUNbtEj5O2haaqjg4yuCmKp4WUnJPr+em4l4t2CtcpVtj+zU8gw/Kun++pipuxHG8aCOdr+COsm7X+wZsBxAnvRef23yNLuBDLOGqUA2P4MkENtUbZd2+PBZAhDiMj4SUOqpWbU5mS8JVPCdsydVhgzc5nrJuf8JdeFdwPMN0BS9gH95L2u8UPMNL+DE6rE71WbKemqrYI9iy+wRPWAimZAVf49OeFYv+4I/Yr28qHC3rdmB+6ATIVVMVPwueYJD+FMp8H8Qw05mrc0PezWAxOq+JAZzA5REgyokAlHV7GQ/j720gvk0hdvIPKOv2Ah4ScsYwiMXe7dixQ5iqqYpD+MLw8r6MIxMBiBCz+GobiPcnBhAhDkaIPR1dVnf0DGxVPBNHbbjmrdo1UYAIcVFwyqsDXp+d6Bakiqf+JB4Ubt9neO4/LujK+EKJZ8QAAAAASUVORK5CYII=
endtext
rand(-1)
local m.n
m.n=INT(3*RAND() +1)
do case
case m.n=1
this.pictureVal=strconv(m.myvar,14)
case m.n=2
this.pictureVal=strconv(m.myvar1,14)
case m.n=3
this.pictureVal=strconv(m.myvar2,14)
endcase
ENDPROC
PROCEDURE text1.Init
with this
.fontsize=11
.top=4
.left = .parent.image1.left + .parent.image1.width+1
.width=.parent.width-.left-8
.height=.parent.height-8
.zorder(1)
.enabled=.f.
endwith
ENDPROC
PROCEDURE label1.Init
with this
.fontsize=11
.forecolor=rgb(95,95,95)
.backcolor=rgb(255,255,255)
.top=.parent.text1.top
.left=.parent.text1.left
.width=.parent.text1.width
.height=.parent.text1.height
.zorder(0)
endwith
ENDPROC
PROCEDURE label1.Click
this.parent.text1.enabled=.t.
This.Parent.text1.SetFocus
ENDPROC
procedure image1.click && popup to customize
SET COLOR OF SCHEME 1 TO N+/w*,B+/W+*,,,,G/BG+
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL() Color Scheme 1
DEFINE BAR 1 OF raccourci PROMPT "change colors" ;
PICTURE home(1)+"graphics\icons\misc\misc15.ico"
DEFINE BAR 2 OF raccourci PROMPT "no autocomp" ;
PICTURE home(1)+"graphics\icons\misc\circ1.ico"
DEFINE BAR 3 OF raccourci PROMPT "border" ;
PICTURE home(1)+"graphics\icons\misc\circ2.ico"
DEFINE BAR 4 OF raccourci PROMPT "item3" ;
PICTURE home(1)+"graphics\icons\misc\circ3.ico"
ON SELECTION BAR 1 OF raccourci _screen.activeform.ysearch1._53519svip()
ON SELECTION BAR 2 OF raccourci _screen.activeform.ysearch1.text1.autocomplete=0
ON SELECTION BAR 3 OF raccourci _screen.activeform.ysearch1.borderwidth=iif(_screen.activeform.ysearch1.borderwidth=1,0,1)
ACTIVATE POPUP raccourci
endproc
PROCEDURE _53519svip && the white color is better
with _screen.activeform
.ysearch1.backcolor=getcolor()
.ysearch1.label1.backcolor=.ysearch1.backcolor
endwith
endproc
ENDDEFINE
*
*-- EndDefine: ysearch
Can separate the search methods to use one only.
Click on code to select [then copy] -click outside to deselect
*2* created on wednesday 17 of january 2018
* *searching a string in any file ( can be edited).
*search any string in any file. if found edit this file and select the string.if there is many strings issue F3 to cycle between all found strings.
*search can be also in a folder (search a string in all files ,opening them simultaneously and select the found string...)
*the used trick is the [modify command range1,range2] and gathering the ranges into a cursor.
*RANGE nStartCharacter, nEndCharacter In principe first range1,ragne2 is suffisent for this demo.
*Specifies a range of characters selected when the editing window is opened. Characters are selected starting at the position specified with nStartCharacter
*up to (but not including) the character position of nEndCharacter. If nStartCharacter is equal to nEndCharacter, no characters are selected, and the cursor
*is placed at the position specified with nStartCharacter.
*AT(cSearchExpression, cExpressionSearched [, nOccurrence])
*AT( ) returns an integer indicating the position of the first character for a character expression
Local m.xfile
m.xfile=Getfile()
If Empty(m.xfile)
Return .F.
Endi
Local m.x
m.x=Inputbox("string to search","","a")
If Empty(m.x)
Return .F.
Endi
m.x=Allt(m.x)
Local m.ystr
m.ystr=Filetostr(m.xfile)
Create Cursor ycurs(range1 i,range2 i)
N=1
Do While .T.
xval= At(m.x,m.ystr,N) &&search for the string and fill a cursor with ranges
Wait Window xval Nowait
If xval>0
Insert Into ycurs Values (xval,xval+Len(m.x))
N=N+1
Else
Exit
Endi
Enddo
If Reccount()=0
Messagebox(m.x+" not found in "+m.xfile)
Return .F.
Endi
*brow &&in principe first rage1,rage2 is suffisent.
Locate
Wait Window "Press F3 to select next string found" Timeout 1
Local m.ext,m.yfile
m.ext=Lower(Justext(m.xfile))
m.yfile=Addbs(Justpath(m.xfile))+Juststem(m.xfile)
Do Case
Case Inlist(ext,"prg","qpr","mpr","h ")
Modi Comm (m.xfile) Range range1,range2 Nowait Noedit
Case Inlist(ext,"txt","log","lst","ini"," ")
Modi File (m.xfile) Range range1,range2 Nowait Noedit
Case Inlist(ext, "pjx","pjt")
Modi Proj (m.yfile) Nowait
Case Inlist(ext, "frx","frt","lbx","lbt")
Modi Repo (m.yfile) Nowait
Case Inlist(ext, "scx","sct")
Modi Form (m.yfile) Nowait
Case Inlist(ext, "mnx","mnt")
Modi Menu (m.yfile) Nowait
Case Inlist(ext, "qpr")
Modi Query (m.yfile) Nowait
Case Inlist(ext, "dbc","dct")
Modi Database (m.yfile) Nowait
Case Inlist(ext, "vcx","vct")
Do (_Browser) With (m.yfile)
Otherwise
Try && if access file not permitted (for ex fxp file in use)
Modi File (m.xfile) Nowait Range range1,range2 Noedit
Catch
Wait Window "cannot edit the file...no access !" Timeout 1
Endtry
Endcase
Inke(1)
Keyboard "{CTRL+SHIFT+F3}" &&Update Find with the word or selected characters at the cursor position for a previous occurrence.F3 to continue..
|
|
Yousfi Benameur |
Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1709(fall creator) & IE11 emulation.