procedure TfrCustomMemoView.WrapMemo;
var
size, size1, maxwidth: Integer;
b: TWordBreaks;
WCanvas: TCanvas;
desc, aword: string;
procedure OutLine(const str: String);
var
n, w: Word;
begin
n := Length(str);
if (n > 0) and (str[n] = #1) then
w := WCanvas.TextWidth(Copy(str, 1, n - 1)) else
w := WCanvas.TextWidth(str);
{$IFDEF DebugLR_detail}
debugLn('Outline: str="%s" w/=%d w%%=%d',[copy(str,1,12),w div 256, w mod 256]);
{$ENDIF}
SMemo.Add(str + Chr(w div 256) + Chr(w mod 256));
Inc(size, size1);
end;
procedure WrapLine(const s: String);
var
i, cur, beg, last, len: Integer;
WasBreak, CRLF, IsCR: Boolean;
ch: TUTF8char;
function UTF8Desc(S: string; var Desc: string): Integer;
// create Desc as an array with Desc[i] is the size of the UTF-8 codepoint
var
i,b: Integer;
begin
i := 1;
Result := 0;
SetLength(Desc, Length(S));
while i<=Length(s) do begin
b := UTF8CharacterStrictLength(@S[i]);
inc(i,b);
inc(Result);
Desc[Result] := Char(b);
end;
Setlength(Desc, Result);
end;
function UTF8Char(S: string; index: Integer; Desc: string): TUTF8Char;
var
i,j: Integer;
begin
Result := '';
if (index<1) or (index>Length(Desc)) then begin
//Result := #$EF#$BF#$BD // replacement character
exit;
end;
i:=0; j:=1;
while i<Length(Desc) do begin
inc(i);
if i=index then begin
Move(S[j],Result[1],ord(Desc[i]));
Result[0]:=Desc[i];
break;
end;
inc(j, ord(Desc[i]));
end;
end;
// this assume index is in valid range
function UTF8Index(index: integer; desc: string): Integer;
var
i,c: integer;
begin
result := 0;
c := 0;
for i:=1 to Length(Desc) do begin
inc(c);
if i=index then begin
result := c;
break;
end;
c := c + ord(Desc[i]) - 1;
end;
end;
function UTF8Range(S: string; index, count: Integer; Desc: String
): string;
var
c,i: Integer;
begin
result := '';
c := 0;
i := index;
while (Count>0) and (i<=Length(Desc)) do begin
c := c + ord(Desc[i]);
inc(i);
Dec(Count);
end;
i := {%H-}UTF8Index(Index, Desc);
if i>0 then begin
SetLength(Result, c);
Move(S[i],Result[1],c);
end;
end;
//**********************************************
begin
CRLF := False;
for i := 1 to Length(s) do
begin
if s[i] in [#10, #13] then
begin
CRLF := True;
break;
end;
end;
last := 1; beg := 1;
if not CRLF and ((Length(s) <= 1) or (WCanvas.TextWidth(s) <= maxwidth)) then
begin
OutLine(s + #1)
end else
begin
cur := 1;
Len := UTF8Desc(S, Desc);
while cur <= Len do
begin
Ch := UTF8Char(s, cur, Desc);
// check for items with soft-breaks
IsCR := Ch=#13;
if IsCR then
begin
//handle composite newline
ch := UTF8Char(s, cur+1, desc);
//dont increase char index if next char is LF (#10)
if ch<>#10 then
Inc(Cur);
end;
if Ch=#10 then
begin
OutLine(UTF8Range(s, beg, cur - beg, Desc) + #1);
//increase the char index since it's pointing to CR (#13)
if IsCR then
Inc(cur);
Inc(cur);
beg := cur;
last := beg;
Continue;
end;
if ch <> ' ' then
if WCanvas.TextWidth(UTF8Range(s, beg, cur - beg + 1, Desc)) > maxwidth then
begin
WasBreak := False;
if (Flags and flWordBreak) <> 0 then
begin
// in case of breaking in the middle, get the full word
i := cur;
while (i <= Len) and not UTF8CharIn(ch, [' ', '.', ',', '-']) do
begin
Inc(i);
if i<=len then
ch := UTF8Char(s, i, Desc);
end;
// find word's break points using some simple hyphenator algorithm
// TODO: implement interface so users can use their own hyphenator
// algorithm
aWord := UTF8Range(s, last, i - last, Desc);
if (FHyp<>nil) and (FHyp.Loaded) then
begin
try
b := FHyp.BreakWord(UTF8Lowercase(aWord));
except
b := '';
end;
end else
b := BreakWord(aWord);
// if word can be broken in many segments, find the last segment that
// fits within maxwidth
if Length(b) > 0 then
begin
i := 1;
while (i <= Length(b)) and
(WCanvas.TextWidth(UTF8Range(s, beg, last - beg + Ord(b[i]), Desc) + '-') <= maxwidth) do
begin
WasBreak := True;
cur := last + Ord(b[i]); // cur now points to next char after breaking word
Inc(i);
end;
end;
if (not WasBreak) and (FHyp<>nil) and FHyp.Loaded then
// if hyphenator was specified and is valid don't break
// words which hyphenator didn't break
else
// last now points to nex char to be processed
last := cur;
end
else
begin
if last = beg then
last := cur;
end;
if WasBreak then
begin
// if word has been broken, output the partial word plus an hyphen
OutLine(UTF8Range(s, beg, last - beg, Desc) + '-');
end else
begin
// output the portion of word that fits maxwidth
OutLine(UTF8Range(s, beg, last - beg, Desc));
// if space was found, advance to next no space char
while (UTF8Char(s, last, Desc) = ' ') and (last < Length(s)) do
Inc(last);
end;
beg := last;
end;
if UTF8CharIn(Ch, [' ', '.', ',', '-']) then
last := cur;
Inc(cur);
end;
if beg <> cur then
OutLine(UTF8Range(s, beg, cur - beg + 1, Desc) + #1);
end;
end;