不是太细,也没怎么测试,凑活看看吧
版本fr2.5,修改fr_class.pas文件:
procedure TfrMemoView.WrapMemo;
var
size, size1, maxwidth, textWidth: Integer;
b: TWordBreaks;
WCanvas: TCanvas;
lineText: string;
procedure OutLine(const str: string);
begin
SMemo.Add(str);
Inc(size, size1);
end;
procedure WrapLine(const s: string);
var
i, cur, beg, last, LoopPos: Integer;
WasBreak, CRLF: Boolean;
interpunctions: TStringList;
begin
interpunctions := TStringList.Create;//未做释放,为了方便看就放这里创建了
//不易放在句首的标点
interpunctions.text := '。'#10','#10'!'#10'?'#10'.'#10','#10'!'#10'?';
CRLF := False;
LoopPos := 0;
for i := 1 to Length(s)do
if s in [#10, #13] then
begin
CRLF := True;
break;
end;
last := 1;
beg := 1;
if not CRLF and ((Length(s) <= 1) or (WCanvas.TextWidth(s) <= maxwidth))
then
OutLine(s + #1)
else
begin
cur := 1;
while cur <= Length(s)do
begin
//1 换行符
if s[cur] in [#10, #13] then
begin
OutLine(Copy(s, beg, cur - beg) + #1);
while (cur < Length(s)) and (s[cur] in [#10, #13])do
Inc(cur);
beg := cur;
last := beg;
if s[cur] in [#13, #10] then
Exit
else
continue;
end;
//2 非换行符
if s[cur] <> ' ' then
begin
lineText := Copy(s, beg, cur - beg + 1);
textWidth := WCanvas.TextWidth(lineText);
if textWidth > maxwidth then
begin
WasBreak := False;
if (Flags and flWordBreak) <> 0 then
begin
i := cur;
while (i <= Length(s)) and not (s in spaces)do
Inc(i);
b := BreakWord(Copy(s, last + 1, i - last - 1));
if Length(b) > 0 then
begin
i := 1;
cur := last;
while (i <= Length(b)) and
(WCanvas.TextWidth(Copy(s, beg, last - beg + 1 + Ord(b)) +
'-') <= maxwidth)do
begin
WasBreak := True;
cur := last + Ord(b);
Inc(i);
end;
last := cur;
end;
end
else
if last = beg then
last := cur;
if WasBreak then
OutLine(Copy(s, beg, last - beg + 1) + '-')
else
if s[last] = ' ' then
OutLine(Copy(s, beg, last - beg))
else
begin
if last = beg then
begin
last := cur;
end;
//************ 未考虑连续标点情况:”。
if (ByteType(s, cur) = mbLeadByte) or (ByteType(s, cur) = mbSingleByte) then
begin
if (interpunctions.indexof(s[cur] + s[cur + 1]) <> -1) or (interpunctions.indexof(s[cur]) <> -1) then
begin
if ByteType(s, cur - 1) = mbTrailByte then
begin
lineText := Copy(s, beg, last - beg - 2);
//multi-byte
last := last - 2;
cur := cur - 2;
end
else
begin
lineText := Copy(s, beg, last - beg - 1);
// single byte
last := last - 1;
cur := cur - 1;
end;
end
else
lineText := Copy(s, beg, last - beg);
end
else
//*************************
begin
lineText := Copy(s, beg, last - beg);
end;
OutLine(lineText);
Dec(last);
end;
if ((Flags and flWordBreak) <> 0) and not WasBreak and (last = cur - 1) then
begin
if LoopPos = cur then
begin
beg := cur + 1;
cur := Length(s);
break;
end
else
LoopPos := cur;
end;
beg := last + 1;
last := beg;
end;
end;
if s[cur] = ' ' then
last := cur;
{$IFNDEF Delphi2} // is not delphi2
if ByteType(s, cur) = mbLeadByte then
Inc(cur, 2)
else
{$ENDIF}
Inc(cur);
end;
if beg <> cur then
//the ending
begin
lineText := Copy(s, beg, cur - beg + 1) + #1;
end;
OutLine(lineText);
end;
end;
procedure OutMemo;
var
i: Integer;
begin
size := y + gapy;
size1 := -WCanvas.Font.Height + LineSpacing;
maxwidth := dx - gapx - gapx;
if (DocMode = dmDesigning) and (Memo1.Count = 1) and
(WCanvas.TextWidth(Memo1[0]) > maxwidth) and
(Memo1[0] <> '') and (Memo1[0][1] = '[') then
OutLine(Memo1[0])
else
for i := 0 to Memo1.Count - 1do
if FWrapped then
OutLine(Memo1)
else
if (Flags and flWordWrap) <> 0 then
WrapLine(Memo1)
else
OutLine(Memo1 + #1);
VHeight := size - y + gapy;
TextHeight := size1;
end;
procedure OutMemo90;
var
i: Integer;
h, oldh: HFont;
begin
h := Create90Font(WCanvas.Font);
oldh := SelectObject(WCanvas.Handle, h);
size := x + gapx;
size1 := -WCanvas.Font.Height + LineSpacing;
maxwidth := dy - gapy - gapy;
for i := 0 to Memo1.Count - 1do
if FWrapped then
begin
OutLine(Memo1);
end
else
if (Flags and flWordWrap) <> 0 then
WrapLine(Memo1)
else
OutLine(Memo1);
SelectObject(WCanvas.Handle, oldh);
DeleteObject(h);
VHeight := size - x + gapx;
TextHeight := size1;
end;
begin
WCanvas := TempBmp.Canvas;
WCanvas.Font.Assign(Font);
WCanvas.Font.Height := -Round(Font.Size * 96 / 72);
SetTextCharacterExtra(WCanvas.Handle, CharacterSpacing);
SMemo.Clear;
if (Alignment and $4) <> 0 then
OutMemo90
else
OutMemo;
end;