unit uTextMan;
{ This sourcecode is released under the GPLv3.
Written by Mematis
http://www.mematis.com }
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, lazutf8;
type
TStrArray = array of string;
const
// Instr mode flags
isForward = 0;
isBackward = 1;
isNumber = 2;
isNoCase = 4;
// useful filters for TextItems
tiNumberDigits = '0123456789';
tiRealNumberDigits = '.' + tiNumberDigits;
procedure Replace(var source: string; const oldstr, newstr: string;
CaseSensitive: boolean = true);
procedure ReplaceAll(var source: string; const oldstr, newstr: string;
CaseSensitive: boolean = true);
function InStr(const SourceString: string; const SearchString: string; const
SearchMode: longint = isForward; const OrdSelector: longint = 0): longint;
function InStr(StartPos: longint; const SourceString: string; const
SearchString: string; SearchMode: longint = isForward; const OrdSelector:
longint = 0): longint;
function TextItems(const SourceString, SearchString: string): TStrArray;
implementation
procedure Replace(var source: string; const oldstr, newstr: string;
CaseSensitive: boolean = true);
var
l, mode, p: longint;
begin
mode := isForward;
if not CaseSensitive then
mode := mode or isNoCase;
p := InStr(source, oldstr, mode);
if p > 0 then
begin
l := UTF8Length(oldstr);
UTF8Delete(source, p, l);
UTF8Insert(newstr, source, p);
end;
end;
procedure ReplaceAll(var source: string; const oldstr, newstr: string;
CaseSensitive: boolean = true);
var
la, lb, mode, p: longint;
begin
p := 0;
la := UTF8Length(oldstr);
lb := UTF8Length(newstr);
mode := isForward;
if not CaseSensitive then
mode := mode or isNoCase;
repeat
p := InStr(p, source, oldstr, mode);
if p > 0 then
begin
UTF8Delete(source, p, la);
UTF8Insert(newstr, source, p);
p := p + lb;
end;
until p = 0;
end;
function InStr(StartPos: longint; const SourceString: string; const
SearchString: String; SearchMode: longint = isForward; const OrdSelector:
longint = 0): longint;
{ - Originally written by Kevin Provance:
http://www.vincenzo.net/isxkb/index.php?title=Instr_for_Pascal.
- Modifcations including UTF8 support by Mematis:
http://www.mematis.com }
var
a, b, i, p: longint;
tmpStr1, tmpStr2, Str1: string;
begin
result := 0;
if Length(SourceString) = 0 then
exit;
tmpStr1 := SourceString;
tmpStr2 := SearchString;
if (SearchMode and isBackward) = 0 then
SearchMode := (SearchMode or isForward);
if (SearchMode and isNoCase) <> 0 then
begin
tmpStr1 := LowerCase(tmpStr1);
tmpStr2 := LowerCase(tmpStr2);
end;
p := OrdSelector;
if p = 0 then
p := 1;
p := p - 1;
case (SearchMode and 1) of
isForward:
begin
if StartPos = 0 then
StartPos := 1;
a := StartPos;
b := UTF8Length(tmpStr1);
for i := a to b do
begin
Str1 := UTF8Copy(tmpStr1, i, UTF8Length(tmpStr2));
if Str1 = tmpStr2 then
begin
if (SearchMode and isNumber) <> 0 then
result := result + 1
else
begin
result := i;
if p = 0 then
exit
else
p := p - 1;
end;
end;
end;
end;
isBackward:
begin
if StartPos = 0 then
StartPos := UTF8Length(tmpStr1);
a := StartPos;
b := 1;
for i := a downto b do
begin
Str1 := UTF8Copy(tmpStr1, i, UTF8Length(tmpStr2));
if Str1 = tmpStr2 then
begin
if (SearchMode and isNumber) <> 0 then
begin
result := result + 1;
end
else
begin
result := (a - i) + UTF8Length(tmpStr2);
if p = 0 then
exit
else
p := p - 1;
end;
end;
end;
end;
end;
if (SearchMode and isNumber) = 0 then
result := 0;
end;
function InStr(const SourceString: string; const SearchString: string; const
SearchMode: longint = isForward; const OrdSelector: longint = 0): longint;
// in case you do not need the start position
begin
result := Instr(0, SourceString, SearchString, SearchMode, OrdSelector);
end;
function TextItems(const SourceString, SearchString: string): TStrArray;
// If nothing is found, an empty array is returned (upperbound -1).
{ This function can be used to find specific elements in a text, such as
date elements:
s := '1\15\2015' // any fancy separator other than a number
TStrArray := TextItems(s, tiNumberDigits);
-> TStrArray[0] = '1'
-> TStrArray[1] = '15'
-> TStrArray[2] = '2015' }
var
t: TStrArray;
i, n: longint;
s: string;
match: boolean;
begin
match := false;
n := -1;
for i := 1 to UTF8Length(SourceString) do
begin
s := UTF8Copy(SourceString, i, 1);
if UTF8Pos(s, SearchString) > 0 then
if match then
t[n] := t[n] + s
else
begin
inc(n);
SetLength(t, n + 1);
t[n] := s;
match := true;
end
else
if match then
match := false;
end;
result := t;
end;
end.
Recent
