盒子论坛 v2.1

//以下代码支持 fr 6.0.7
UseDefaultCharset 改为 True

修改 frxGraphicUtils.pas
的 procedure TfrxDrawText.WrapTextLine

//fix or add by flying wang.
{$IFDEF DELPHI16}
function IsCanBreakChar(c: UCS4Char): Boolean;
{$ELSE}
function IsCanBreakChar(c: DWORD): Boolean;
{$ENDIF}
begin
Result := False;
//

http://www.qqxiuzi.cn/zh/hanzi-unicode-bianma.php
//基本汉字  20902字  4E00-9FA5
  if ($4E00 <= c) and (c <= $9FA5) then Result := True;
  if Result then exit;
//基本汉字补充  38字  9FA6-9FCB
  if ($9FA6 <= c) and (c <= $9FCB) then Result := True;
  if Result then exit;
//扩展A  6582字  3400-4DB5
  if ($3400 <= c) and (c <= $4DB5) then Result := True;
  if Result then exit;
//扩展B  42711字  20000-2A6D6
  if ($20000 <= c) and (c <= $2A6D6) then Result := True;
  if Result then exit;
//扩展C  4149字  2A700-2B734
  if ($2A700 <= c) and (c <= $2B734) then Result := True;
  if Result then exit;
//扩展D  222字  2B740-2B81D
  if ($2B740 <= c) and (c <= $2B81D) then Result := True;
  if Result then exit;
//扩展E  5762字  2B820-2CEA1
  if ($2B820 <= c) and (c <= $2CEA1) then Result := True;
  if Result then exit;
//扩展F  7473字  2CEB0-2EBE0
  if ($2CEB0 <= c) and (c <= $2EBE0) then Result := True;
  if Result then exit;
//康熙部首  214字  2F00-2FD5
//部首扩展  115字  2E80-2EF3
//兼容汉字  477字  F900-FAD9
  if ($F900 <= c) and (c <= $FAD9) then Result := True;
  if Result then exit;
//兼容扩展  542字  2F800-2FA1D
  if ($2F800 <= c) and (c <= $2FA1D) then Result := True;
  if Result then exit;
//PUA(GBK)部件  81字  E815-E86F
  if ($E815 <= c) and (c <= $E86F) then Result := True;
  if Result then exit;
//部件扩展  452字  E400-E5E8
  if ($E400 <= c) and (c <= $E5E8) then Result := True;
  if Result then exit;
//PUA增补  207字  E600-E6CF
  if ($E600 <= c) and (c <= $E6CF) then Result := True;
  if Result then exit;
//汉字笔画  36字  31C0-31E3
  if ($31C0 <= c) and (c <= $31C0) then Result := True;
  if Result then exit;
//汉字结构  12字  2FF0-2FFB
  if ($2FF0 <= c) and (c <= $2FFB) then Result := True;
  if Result then exit;
//汉语注音  22字  3105-3120
//注音扩展  22字  31A0-31BA
//〇  1字  3007
  if ($3007 <= c) and (c <= $3007) then Result := True;
  if Result then exit;
//

https://blog.csdn.net/lb521200200/article/details/53606864
//所有的汉字日文汉字假名标点符号都可以换行。只有部首、注音和拼音不能。
//2）全角ASCII、全角中英文标点、半宽片假名、半宽平假名、半宽韩文字母：FF00-FFEF
if ($FF00 <= c) and (c <= $FFEF) then Result := True;
  if Result then exit;
//3）CJK部首补充：2E80-2EFF
if ($2E80 <= c) and (c <= $2EFF) then Result := True;
  if Result then exit;
//4）CJK标点符号：3000-303F
if ($3000 <= c) and (c <= $303F) then Result := True;
  if Result then exit;
//5）CJK笔划：31C0-31EF
if ($31C0 <= c) and (c <= $31EF) then Result := True;
  if Result then exit;
//6）康熙部首：2F00-2FDF
//7）汉字结构描述字符：2FF0-2FFF
if ($2FF0 <= c) and (c <= $2FFF) then Result := True;
  if Result then exit;
//8）注音符号：3100-312F
//9）注音符号（闽南语、客家语扩展）：31A0-31BF
//10）日文平假名：3040-309F
if ($3040 <= c) and (c <= $309F) then Result := True;
  if Result then exit;
//11）日文片假名：30A0-30FF
if ($30A0 <= c) and (c <= $30FF) then Result := True;
  if Result then exit;
//12）日文片假名拼音扩展：31F0-31FF
if ($31F0 <= c) and (c <= $31FF) then Result := True;
  if Result then exit;
//13）韩文拼音：AC00-D7AF
if ($AC00 <= c) and (c <= $D7AF) then Result := True;
  if Result then exit;
//14）韩文字母：1100-11FF
if ($1100 <= c) and (c <= $11FF) then Result := True;
  if Result then exit;
//15）韩文兼容字母：3130-318F
if ($3130 <= c) and (c <= $318F) then Result := True;
  if Result then exit;
//16）太玄经符号：1D300-1D35F
if ($1D300 <= c) and (c <= $1D35F) then Result := True;
  if Result then exit;
//17）易经六十四卦象：4DC0-4DFF
if ($4DC0 <= c) and (c <= $4DFF) then Result := True;
  if Result then exit;
//18）彝文音节：A000-A48F
//19）彝文部首：A490-A4CF
//20）盲文符号：2800-28FF
if ($2800 <= c) and (c <= $28FF) then Result := True;
  if Result then exit;
//21）CJK字母及月份：3200-32FF
if ($3200 <= c) and (c <= $32FF) then Result := True;
  if Result then exit;
//22）CJK特殊符号（日期合并）：3300-33FF
if ($3300 <= c) and (c <= $33FF) then Result := True;
  if Result then exit;
//23）装饰符号（非CJK专用）：2700-27BF
if ($2700 <= c) and (c <= $27BF) then Result := True;
  if Result then exit;
//24）杂项符号（非CJK专用）：2600-26FF
if ($2600 <= c) and (c <= $26FF) then Result := True;
  if Result then exit;
//25）中文竖排标点：FE10-FE1F
if ($FE10 <= c) and (c <= $FE1F) then Result := True;
  if Result then exit;
//26）CJK兼容符号（竖排变体、下划线、顿号）：FE30-FE4F
if ($FE30 <= c) and (c <= $FE4F) then Result := True;
  if Result then exit;
end;

procedure TfrxDrawText.WrapTextLine(s: {$IFDEF FPCUNICODE}String{$ELSE}WideString{$ENDIF};
  Width, FirstLineWidth, CharSpacing: Integer);
var
  //fix or add by flying wang.
  LastIsSpace: Boolean;
  n, i, Offset, LineBegin, LastSpace, BreakPos: Integer;
  sz: TSize;
  TheWord: {$IFDEF FPCUNICODE}String{$ELSE}WideString{$ENDIF};
  WasBreak: Boolean;
  Tag: TfrxHTMLTag;
  {$IFDEF FPC}
  AddNext: Boolean;
  addI: Integer;
  {$ENDIF}

  function BreakWord(const s: {$IFDEF FPCUNICODE}String{$ELSE}WideString{$ENDIF}; LineBegin, CurPos, LineEnd: Integer): {$IFDEF FPCUNICODE}String{$ELSE}WideString{$ENDIF};
  var
    i, BreakPos: Integer;
    TheWord, Breaks: {$IFDEF FPCUNICODE}String{$ELSE}WideString{$ENDIF};
  begin
    // get the whole word
    i := CurPos;
    while (i <= LineEnd) and
       (frxPos(
         {$IFDEF FPC}frxCopy(s, i, 1){$ELSE}s[i]{$ENDIF}, ' .,-;') = 0) do
      Inc(i);
    TheWord := frxCopy(s, LineBegin, i - LineBegin);
    // get available break positions
    Breaks := BreakRussianWord(frxUpperCase(TheWord));
    // find the closest position
    BreakPos := CurPos - LineBegin;
    for i := Length(Breaks) downto 1 do
      if Ord(Breaks[i]) < BreakPos then
      begin
        BreakPos := Ord(Breaks[i]);
        break;
      end;
    if BreakPos <> CurPos - LineBegin then
      Result := frxCopy(TheWord, 1, BreakPos) else
      Result := '';
  end;

begin
// remove all HTML tags and build the tag list
  FHTMLTags.NewLine;
  FHTMLTags.ExpandHTMLTags(s);
  FHTMLTags.FPosition := FHTMLTags.FPosition + 2;

  n := frxLength(s);
  if (n < 2) or not FWordWrap then  // no need to wrap a string with 0 or 1 symbol
  begin
    FText.Add(s);
    Tag := FHTMLTags.Items[FHTMLTags.Count - 1].Items[0];
    if not Tag.Default then
      Canvas.Font.Style := Tag.Style;
    Exit;
  end;

// get the intercharacter spacing table and calculate the width
  FCanvas.Lock;
  try
    sz.cx := FHTMLTags.FillCharSpacingArray(FTempArray, s, FCanvas,
      FHTMLTags.Count - 1, CharSpacing, True, {$IFDEF JPN}true{$ELSE}FUseDefaultCharset{$ENDIF});
  finally
    FCanvas.Unlock;
  end;

// text fits, no need to wrap it
  if sz.cx < FirstLineWidth then
  begin
    FText.Add(s);
    Exit;
  end;
  {$IFDEF FPC}
   AddNext := True;
   addI := 0;
   {$ENDIF}
  Offset := 0;
  i := 1;
  LineBegin := 1; // index of the first symbol in the current line
  LastSpace := 1; // index of the last space symbol in the current line

  while i <= n do
  begin
    if ({$IFDEF FPC}frxCopy(s, i, 1){$ELSE}s[i]{$ENDIF} = ' ') then
    begin
      //fix or add by flying wang.
      LastIsSpace := True;
      if (FHTMLTags.AllowTags) and (FHTMLTags.Count > 0) then
      begin
        if (not FHTMLTags[FHTMLTags.Count - 1].Items[i - LineBegin].DontWRAP) then
          LastSpace := i;
      end
      else
        LastSpace := i;
    end
    //fix or add by flying wang.
    else if UseDefaultCharset and IsCanBreakChar(Ord({$IFDEF FPC}frxCopy(s, i, 1){$ELSE}s[i]{$ENDIF})) then // fix by flying wang.
    begin
      LastSpace := i;
      LastIsSpace := False;
    end;

    if FTempArray[i - 1{$IFDEF FPC} - addI{$ENDIF}] - Offset > FirstLineWidth then  // need wrap
    begin
      if LastSpace = LineBegin then  // there is only one word without spaces...
      begin
        if i <> LineBegin then       // ... and it has more than 1 symbol
        begin
          if FWordBreak then
          begin
          TheWord := BreakWord(s, LineBegin, i, n);
          WasBreak := TheWord <> '';
          if not WasBreak then
          TheWord := frxCopy(s, LineBegin, i - LineBegin);
          if WasBreak then
          FText.Add(TheWord + '-') else
          FText.Add(TheWord);
          BreakPos := frxLength(TheWord);
          FHTMLTags.Wrap(BreakPos, WasBreak);
          LastSpace := LineBegin + BreakPos - 1;
          end
          else
          begin
          FText.Add(frxCopy(s, LineBegin, i - LineBegin));
          FHTMLTags.Wrap(i - LineBegin, False);
          LastSpace := i - 1;
          end;
        end
        else
        begin
          FText.Add({$IFDEF FPC}frxCopy(s, LineBegin, 1){$ELSE}s[LineBegin]{$ENDIF}); // can't wrap 1 symbol, just add it to the new line
          FHTMLTags.Wrap(1, False);
        end;
      end
      else // we have a space symbol inside
      begin
        if FWordBreak then
        begin
          TheWord := BreakWord(s, LastSpace + 1, i, n);
          WasBreak := TheWord <> '';
          if WasBreak then
          FText.Add(frxCopy(s, LineBegin, LastSpace - LineBegin + 1) + TheWord + '-') else
          FText.Add(frxCopy(s, LineBegin, LastSpace - LineBegin));
          //fix or add by flying wang.
          if not LastIsSpace then
          dec(LastSpace);
          BreakPos := LastSpace - LineBegin + frxLength(TheWord) + 1;
          FHTMLTags.Wrap(BreakPos, WasBreak);
          if WasBreak then
          LastSpace := LineBegin + BreakPos - 1;
        end
        else
        begin
          FText.Add(frxCopy(s, LineBegin, LastSpace - LineBegin));
          //fix or add by flying wang.
          if not LastIsSpace then
          dec(LastSpace);
          FHTMLTags.Wrap(LastSpace - LineBegin + 1, False);
        end;
      end;

      Offset := FTempArray[LastSpace - 1{$IFDEF FPC} - addI{$ENDIF} ]; // starting a new line
      i := LastSpace;
      Inc(LastSpace);
      LineBegin := LastSpace;
      FirstLineWidth := Width; // this line is not first, so use Width
    end;

    Inc(i);
  end;

  if n - LineBegin + 1 > 0 then   // put the rest of line to FText
    FText.Add(frxCopy(s, LineBegin, n - LineBegin + 1));
end;
----------------------------------------------
(C)(P)Flying Wang

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/7/30 13:09:19

4楼：

FastReports 6.0.7 Fix By Flying Wang V2018.07.30 D4-RAD10.2 FullSource
http://www.2pascal.com/forum.php?mod=viewthread&tid=2738&fromuid=4
(出处: 2Pascal-新时代的Pascal)
----------------------------------------------
(C)(P)Flying Wang

作者：

xxhadsg (garfield)	★☆☆☆☆	-
	盒子活跃会员

2018/7/30 13:57:49

5楼：

非常感谢 wang_80919 (Flying Wang) ！！！
----------------------------------------------
这个世界上还有很多比钱更重要的东西，比如说意大利面---加菲猫

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/7/30 16:05:17

6楼：

写那么多，其实啥用也没有。
还不如下面只做一行修改效果好。

  while i <= n do
  begin
    //fix or add by flying wang.
    if ({$IFDEF FPC}frxCopy(s, i, 1){$ELSE}s[i]{$ENDIF} = ' ') and (LastSpace + 1 <> i) then
      if (FHTMLTags.AllowTags) and (FHTMLTags.Count > 0) and (LastSpace + 1 <> i) then
      begin
        if (not FHTMLTags[FHTMLTags.Count - 1].Items[i - LineBegin].DontWRAP) then
          LastSpace := i;
      end
      else
        LastSpace := i;
----------------------------------------------
(C)(P)Flying Wang

作者：

xxhadsg (garfield)	★☆☆☆☆	-
	盒子活跃会员

2018/7/30 18:25:27

7楼：

高手！我都没想明白怎么找出问题出在哪里 :-)
----------------------------------------------
这个世界上还有很多比钱更重要的东西，比如说意大利面---加菲猫

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/7/30 19:14:42

8楼：

我只想知道 6 楼的代码，是不是满足你们的需要了。
反正我测试了 6 楼代码效果和 3 楼的差不多。对于英文，比 3 楼的还正常。
----------------------------------------------
(C)(P)Flying Wang

作者：

xxhadsg (garfield)	★☆☆☆☆	-
	盒子活跃会员

2018/7/31 6:24:27

9楼：

还是有问题，中文和英文当有连续多个空格的时候有问题。

我简单将这段代码注释掉：

if (s[i] = ' ') then
      if (FHTMLTags.AllowTags) and (FHTMLTags.Count > 0) then
      begin
        if (not FHTMLTags[FHTMLTags.Count - 1].Items[i - LineBegin].DontWRAP) then
          LastSpace := i;
      end
      else
        LastSpace := i;

然后就可以了，但不清楚注释掉后对别的有没有影响，看这段代码主要是针对空格的处理。
----------------------------------------------
这个世界上还有很多比钱更重要的东西，比如说意大利面---加菲猫

作者：

wang_80919 (Flying Wang)	★☆☆☆☆	-
	普通会员

2018/7/31 8:29:59

10楼：

问题描述不清。
懒得理你。
----------------------------------------------
(C)(P)Flying Wang

信息

登陆以后才能回复