RM报表 文本框 自动换行 相关代码

procedure TRMCustomMemoView.WrapMemo1(aAddChar: Boolean);
var
  lCurHeight, lOneLineHeight, lMaxWidth: Integer;
  lWCanvas: TCanvas;

  procedure _OutLine(const lStr: WideString);
  begin
    FSMemo.Add(lStr);
    Inc(lCurHeight, lOneLineHeight);
  end;

  procedure _WrapOutMemo;
  var
    h, oldh: HFont;
    i: Integer;
  begin
    h := RMCreateAPIFont(lWCanvas.Font, 0, FFontScaleWidth);
    oldh := SelectObject(lWCanvas.Handle, h);

    try
      lCurHeight := 0;
      lOneLineHeight := -lWCanvas.Font.Height + LineSpacing; //每一行高度;
      lMaxWidth := spWidth - spGapLeft * 2 - _CalcHFrameWidth(LeftFrame.spWidth, RightFrame.spWidth);
      if (DocMode = rmdmDesigning) and (FParentReport.FDesigner.Factor <> 100) then
        lMaxWidth := Round(lMaxWidth * 100 / FParentReport.FDesigner.Factor);

      if (DocMode = rmdmDesigning) and (FMemo1.Count = 1) and
        (RMWideCanvasTextWidth(lWCanvas, FMemo1[0]) > lMaxWidth) and
        (FMemo1[0] <> '') and (FMemo1[0][1] = '[') then
        _OutLine(FMemo1[0])
      else
      begin
        if not FNeedWrapped then //不需要换行
        begin
          for i := 0 to FMemo1.Count - 1 do
            _OutLine(FMemo1[i]);
        end
        else if WordWrap or AllowHtmlTag then //自动换行
        begin
          lCurHeight := lCurHeight + RMWrapStrings(FMemo1, FSMemo, lWCanvas, lMaxWidth, LineSpacing {lOneLineHeight},
            WordBreak, CharWrap, AllowHtmlTag, True, aAddChar);

          FSMemo.Add(#1);
        end
        else //不自动换行
        begin
          for i := 0 to FMemo1.Count - 1 do
          begin
            _OutLine(FMemo1[i]);
          end;

          FSMemo.Add(#1);
        end;
      end;
    finally
      FVHeight := lCurHeight - LineSpacing;
      LineHeight := lOneLineHeight;
      SelectObject(lWCanvas.Handle, oldh);
      DeleteObject(h);
    end;
  end;

  procedure _WrapOutMemo90;
  var
    h, oldh: HFont;
    i: Integer;
  begin
    h := RMCreateAPIFont(lWCanvas.Font, 90, FFontScaleWidth);
    oldh := SelectObject(lWCanvas.Handle, h);
    try
      lCurHeight := 0;
      lOneLineHeight := -lWCanvas.Font.Height + LineSpacing;
      lMaxWidth := spHeight - spGapTop * 2 - _CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth);
      if not FNeedWrapped then
      begin
        for i := 0 to FMemo1.Count - 1 do
          _Outline(FMemo1[i]);
      end
      else if WordWrap then
        lCurHeight := lCurHeight + RMWrapStrings(FMemo1, FSMemo, lWCanvas, lMaxWidth, LineSpacing {lOneLineHeight},
          WordBreak, CharWrap, AllowHtmlTag, True, aAddChar)
      else
      begin
        for i := 0 to FMemo1.Count - 1 do
          _Outline(FMemo1[i]);
      end;
    finally
      FVHeight := lCurHeight - LineSpacing;
      LineHeight := lOneLineHeight;
      SelectObject(lWCanvas.Handle, oldh);
      DeleteObject(h);
    end;
  end;

  procedure _WrapOutMemo180;
  var
    i: Integer;
  begin
    lCurHeight := 0;
    lOneLineHeight := -lWCanvas.Font.Height + LineSpacing; //每一行高度;
    lMaxWidth := spHeight - spGapTop * 2 - _CalcVFrameWidth(TopFrame.spWidth, BottomFrame.spWidth);

    if (DocMode = rmdmDesigning) and (FMemo1.Count = 1) and
      (RMWideCanvasTextWidth(lWCanvas, FMemo1[0]) > lMaxWidth) and
      (FMemo1[0] <> '') and (FMemo1[0][1] = '[') then
      _OutLine(FMemo1[0])
    else
    begin
      if not FNeedWrapped then //已经换行
      begin
        for i := 0 to FMemo1.Count - 1 do
          _OutLine(FMemo1[i]);
      end
      else if WordWrap then //自动换行
      begin
        lCurHeight := lCurHeight + RMWrapStrings(FMemo1, FSMemo, lWCanvas, lMaxWidth, LineSpacing {lOneLineHeight},
          WordBreak, CharWrap, AllowHtmlTag, False, aAddChar);
      end
      else //不自动换行
      begin
        for i := 0 to FMemo1.Count - 1 do
        begin
          _OutLine(FMemo1[i]);
        end;
      end;
    end;
    FVHeight := lCurHeight - LineSpacing;
    LineHeight := lOneLineHeight;
  end;

  procedure _ChangeFontSize;
  var
    i: Integer;
    lStr: string;
    lMaxWidth: Integer;
  begin
    lMaxWidth := spWidth - spGapLeft * 2 - _CalcHFrameWidth(LeftFrame.spWidth, RightFrame.spWidth);
    if lMaxWidth < 10 then Exit;

    for i := 0 to FMemo1.Count - 1 do
    begin
      lStr := FMemo1[i];
      while (RMWideCanvasTextWidth(lWCanvas, lStr) > lMaxWidth) and (lWCanvas.Font.Size > 0) do
        lWCanvas.Font.Size := lWCanvas.Font.Size - 1;
    end;

    Font.Size := lWCanvas.Font.Size;
  end;

begin
  if not AutoAddBlank then
    aAddChar := False;
  if RotationType <> rmrtNone then
    AllowHtmlTag := False;

  FParentReport.DrawCanvas.LockCanvas;
  try
    lWCanvas := FParentReport.DrawCanvas.Canvas;
    lWCanvas.Font.Assign(Font);
    lWCanvas.Font.Height := -Round(Font.Size * 96 / 72);
    SetTextCharacterExtra(lWCanvas.Handle, CharacterSpacing);
    case FScaleFontType of
      rmstByWidth:
        begin
          if DocMode <> rmdmDesigning then
            _ChangeFontSize;
        end;
      rmstByHeight:
        begin
        end;
    end;

    FSMemo.Clear;
    case RotationType of
      rmrt90, rmrt270: _WrapOutMemo90;
      rmrt180: _WrapOutMemo180;
    else
      _WrapOutMemo;
    end;

    SetTextCharacterExtra(lWCanvas.Handle, 0);
  finally
    FNeedWrapped := False;
    FParentReport.DrawCanvas.UnLockCanvas;
  end;
end;