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

LazUtf8: implement Utf8ReverseString and Utf8RPos. Patch by Bernard Marcelly. Issue #0029817.

Browse Source 
git-svn-id: trunk@51927 -
This commit is contained in:
bart 2016-03-12 14:01:03 +00:00
parent ad8ba1d824
commit 23f36140b5
1 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
components/lazutils/lazutf8.pas
View File

@ -122,6 +122,9 @@ function UTF8QuotedStr(const S, Quote: string): string;
//Utf8 version of MidStr is just Utf8Copy with same parameters, so it is not implemented here
function Utf8StartsText(const ASubText, AText: string): Boolean;
function Utf8EndsText(const ASubText, AText: string): Boolean;
function Utf8ReverseString(p: PChar; const ByteCount: LongInt): string;
function Utf8ReverseString(const AText: string): string; inline;
function Utf8RPos(const Substr, Source: string): integer;
function UTF8WrapText(S, BreakStr :string; BreakChars :TSysCharSet; MaxCol: integer): string; overload;
function UTF8WrapText(S :string; MaxCol :integer) :string; overload;
@ -2839,6 +2842,42 @@ begin
end;
end;
function Utf8ReverseString(p: PChar; const ByteCount: LongInt): string;
var
CharLen, rBytePos: LongInt;
begin
SetLength(Result, ByteCount);
rBytePos := ByteCount + 1;
while (rBytePos > 1) do
begin
CharLen:=UTF8CharacterLength(p);
Dec(rBytePos, CharLen);
Move(p^, Result[rBytePos], CharLen);
Inc(p, CharLen);
end;
end;
function Utf8ReverseString(const AText: string): string; inline;
begin
Result := UTF8ReverseString(PChar(AText), length(AText));
end;
function Utf8RPos(const Substr, Source: string): integer;
var
RevSubstr, RevSource: string; pRev: integer;
begin
if (Pos(Substr, Source) = 0) then
Result := 0
else
begin
RevSubstr := UTF8ReverseString(Substr);
RevSource := UTF8ReverseString(Source);
pRev := UTF8Pos(RevSubstr, RevSource);
Result := UTF8Length(Source) -pRev -UTF8Length(Substr) +2;
end;
end;
function UTF8WrapText(S, BreakStr :string; BreakChars :TSysCharSet; MaxCol: integer): string;
var
P :PChar;