paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 05:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: added HasTxtWord

Browse Source 
git-svn-id: trunk@35677 -
This commit is contained in:
mattias 2012-03-03 17:02:11 +00:00
parent 0d85bc3fdd
commit 5e854c0599
1 changed files with 42 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
components/codetools/basiccodetools.pas
View File

@ -199,6 +199,8 @@ function SearchNextInText(Search: PChar; SearchLen: PtrInt;
StartPos: PtrInt;// 0 based
out MatchStart, MatchEnd: PtrInt;// 0 based
WholeWords: boolean = false; MultiLine: boolean = false): boolean;
procedure HasTxtWord(SearchWord, Txt: PChar; out WholeWord: boolean;
out Count: SizeInt);
// misc
function SubString(p: PChar; Count: SizeInt): string; overload;
@ -5002,6 +5004,46 @@ begin
end;
end;
procedure HasTxtWord(SearchWord, Txt: PChar; out WholeWord: boolean; out
Count: SizeInt);
var
StartChar: Char;
CurSearchP: PChar;
CurTxtP: PChar;
TxtRun: PChar;
begin
WholeWord:=false;
Count:=0;
if (SearchWord=nil) or (SearchWord^=#0) then exit;
if (Txt=nil) or (Txt^=#0) then exit;
TxtRun:=Txt;
StartChar:=SearchWord^;
repeat
while (TxtRun^<>StartChar) and (TxtRun^<>#0) do inc(TxtRun);
if TxtRun^=#0 then exit;
CurSearchP:=SearchWord+1;
CurTxtP:=TxtRun+1;
while (CurTxtP^=CurSearchP^) and (CurTxtP^<>#0) do begin
inc(CurTxtP);
inc(CurSearchP);
end;
if CurSearchP^=#0 then begin
// word found
if ((TxtRun=Txt) or IsNonWordChar[TxtRun[-1]])
and IsNonWordChar[CurTxtP^] then begin
// word boundaries
if not WholeWord then begin
WholeWord:=true;
Count:=1;
end else
inc(Count);
end else
inc(Count);
end;
inc(TxtRun);
until false;
end;
function SubString(p: PChar; Count: SizeInt): string;
var
l: SizeInt;