cxdrawtextutils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 994 行 · 第 1/3 页

  with ATextParams do
  begin
    ABreakByWords :=
      not SingleLine and (WordBreak or (TextAlignX in [taJustifyX, taDistributeX]));
    ABreakByChars := ABreakByWords and CharBreak;
    AIsSpecialProcessedRow := not EditControl and
      not NoClip and not (TextAlignX in [taJustifyX, taDistributeX]) and AIsLastRow and EndEllipsis;
  end;

  AChar := S;
  with ATextRow do
  begin
    for I := 0 to ALength - 1 do
    begin
      if SysLocale.FarEast then
      begin
        ACharLen := cxStrCharLength(AChar);
        if StrByteType(S, I) = mbTrailByte then Continue;
        Inc(AChar, ACharLen);
      end
      else
        ACharLen := 1;
      TextLength := I + ACharLen;

      if (S[I] = Space) or (S[I] = Tab) then //Q99343 don't use ATextParams.BreakChar (bug with Segoe UI)
      begin
        Inc(BreakCount);
        ABreakPos := I;
      end;

      if ((S[I] = CR) or (S[I] = LF)) and not AIsSpecialProcessedRow and
        not ATextParams.SingleLine then
      begin
        Dec(TextLength);
        if ATextParams.TextAlignX = taJustifyX then BreakCount := 0;
        Break;
      end;

      if ABreakByWords or AIsSpecialProcessedRow or ATextParams.SingleLine then
      begin
        if I >= AMinStrLen then
        begin
          if ATextParams.ExpandTabs then
            ATotalTextWidth := cxCalcTextExtents(AHandle, S, TextLength, True).cx
          else
          begin
            ASize := cxCalcTextExtents(AHandle, @S[I], ACharLen, False);
            Inc(ATotalTextWidth, ASize.cx);
          end;
        end;

        if ATotalTextWidth > AWidth then
        begin
          if AIsSpecialProcessedRow or ATextParams.SingleLine then
            Break
          else
          begin
            if ABreakPos <> -1 then
            begin
              TextLength := ABreakPos + 1;
              Break;
            end
            else
              if ABreakByChars then
              begin
                if TextLength > cxStrCharLength(S) then Dec(TextLength, ACharLen);
                Break;
              end;
          end;
        end;
      end;
    end;
    ATextRow.Text := S;

    // truncate trailing spaces
    if ATextParams.TextAlignX in [taJustifyX, taDistributeX] then
      while (TextLength > 0) and
        ((S[TextLength - 1] = Space) or (S[TextLength - 1] = Tab)) do //Q99343 don't use ATextParams.BreakChar (bug with Segoe UI)
      begin
        if BreakCount > 0 then Dec(BreakCount);
        Dec(TextLength);
      end;
  end;

  cxCalcTextRowExtents(AHandle, ATextRow, ATextParams);

  ACRExists := False;
  // correct source string
  Inc(S, ATextRow.TextLength);
  Dec(ALength, ATextRow.TextLength);

  I := 0;
  while (I < ALength) and (S[I] = Space) do //Q99343 don't use ATextParams.BreakChar (bug with Segoe UI)
    Inc(I);
  if (I < ALength) and (S[I] = Tab) then
    Inc(I);
  if (I < ALength) and (S[I] = CR) then
  begin
    Inc(I);
    ACRExists := True;
  end;
  if (I < ALength) and (S[I] = LF) then
    Inc(I);
  Inc(S, I);
  Dec(ALength, I);
  // doesn't justify last row  (like Excel ?)
  if ((ALength = 0) or ACRExists) and (ATextParams.TextAlignX = taJustifyX) then
   ATextRow.BreakCount := 0;
end;

function cxCalcTextParams(AHandle: TCanvasHandle; AFormat: TcxTextOutFormat): TcxTextParams;
var
  ATextMetric: TTextMetric;
begin
  FillChar(Result, SizeOf(Result), 0);
  with Result do
  begin
    GetTextMetrics(AHandle, ATextMetric);
    BreakChar := ATextMetric.tmBreakChar;
    MaxCharWidth := ATextMetric.tmMaxCharWidth;
    RowHeight := ATextMetric.tmHeight;
    CharSet := ATextMetric.tmCharSet;

    TextAlignX := TcxTextAlignX(AFormat and CXTO_HORZ_ALIGN_MASK);
    TextAlignY := TcxTextAlignY(AFormat and CXTO_VERT_ALIGN_MASK shr CXTO_VERT_ALIGN_OFFSET);

    AutoIndents := AFormat and CXTO_AUTOINDENTS <> 0;
    CalcRect := AFormat and CXTO_CALCRECT <> 0;
    CalcRowCount := AFormat and CXTO_CALCROWCOUNT <> 0;
    CharBreak := (AFormat and CXTO_CHARBREAK <> 0) or SysLocale.FarEast;
    EditControl := AFormat and CXTO_EDITCONTROL <> 0;
    EndEllipsis := AFormat and CXTO_END_ELLIPSIS <> 0;
    ExternalLeading := AFormat and CXTO_EXTERNALLEADING <> 0;
    ExpandTabs := AFormat and CXTO_EXPANDTABS <> 0;
    NoClip := AFormat and CXTO_NOCLIP <> 0;
    PreventLeftExceed := AFormat and CXTO_PREVENT_LEFT_EXCEED <> 0;
    PreventTopExceed := AFormat and CXTO_PREVENT_TOP_EXCEED <> 0;
    SingleLine := AFormat and CXTO_SINGLELINE <> 0;
    WordBreak := AFormat and CXTO_WORDBREAK <> 0;

    if ExternalLeading then tmExternalLeading := ATextMetric.tmExternalLeading;
    FullRowHeight := RowHeight + tmExternalLeading;
    if AFormat and CXTO_END_ELLIPSIS = CXTO_END_ELLIPSIS then
      EndEllipsisWidth := cxCalcTextExtents(AHandle, cxEndEllipsisChars, cxEndEllipsisCharsLength, False).cX
    else EndEllipsisWidth := 0;
  end;
end;

function cxCalcTextParams(ACanvas: TCanvas; AFormat: DWORD): TcxTextParams;
begin
  TCanvasAccess(ACanvas).RequiredState([csHandleValid, csFontValid]);
  Result := cxCalcTextParams(ACanvas.Handle, AFormat);
end;

function cxMakeTextRows(AHandle: TCanvasHandle;
  AText: PcxCaptionChar;
  const R: TRect; const ATextParams: TcxTextParams; out ATextRows: TcxTextRows;
  out ACount: Integer; AMaxLineCount: Integer = 0): Boolean;

  function CheckIsLastRow(ATotalHeight, H: Integer): Boolean;
  begin
    with ATextParams do
      if SingleLine then
        Result := True
      else
        if (TextAlignY = taTop) and not CalcRect then
        begin
          if (EditControl{ or EndEllipsis}) and not NoClip then
            Result := ATotalHeight + FullRowHeight > H
          else
            Result := ATotalHeight > H
        end
        else
          Result := (AMaxLineCount > 0) and (ACount = AMaxLineCount);
  end;

  procedure ExpandTextRows(var ACapacity: Integer);
  const
    Delta: Integer = 4;
  begin
    if ACount > ACapacity then
    begin
      Inc(ACapacity, Delta);
      SetLength(ATextRows, ACapacity);
    end;
  end;

var
  P: PcxCaptionChar;
  AIsLastRow, ARectIsSmall: Boolean;
  ATotalHeight, ACapacity, H, W, L, AOffset: Integer;
begin
  ARectIsSmall := False;
  ATextRows := nil;
  ACount := 0;
  if AText <> nil then
  begin
    P := AText;
    AOffset := 0;
    if ATextParams.CalcRect and ATextParams.SingleLine then
    begin
      ACount := 1;
      SetLength(ATextRows, ACount);
      ATextRows[0].Text := P;
      ATextRows[0].TextLength := Length(P);
      cxCalcTextRowExtents(AHandle, ATextRows[0], ATextParams);
    end
    else
    begin
      AIsLastRow := False;
      ATotalHeight := 0;
      ACapacity := 0;
      L := Length(P);
      W := R.Right - R.Left;
      H := R.Bottom - R.Top;
      while (Length(P) <> 0) and not AIsLastRow do
      begin
        Inc(ACount);
        ExpandTextRows(ACapacity);
        Inc(ATotalHeight, ATextParams.FullRowHeight);
        AIsLastRow := CheckIsLastRow(ATotalHeight, H);
        cxGetTextRow(AHandle, P, L, W, AIsLastRow, ATextParams, ATextRows[ACount - 1]);
        ATextRows[ACount - 1].StartOffset := AOffset;
        AOffset := Integer(Pointer(P)) - Integer(Pointer(AText));
        if not AIsLastRow then
          AIsLastRow := L = 0;
        if (AMaxLineCount > 0) and (ACount = AMaxLineCount) then
          Break;
      end;
      with ATextParams do
        ARectIsSmall := not SingleLine and not CalcRect and
          (AMaxLineCount > 0) and (ACount = AMaxLineCount) and (L > 0);
      if ACapacity > ACount then
        SetLength(ATextRows, ACount);
    end;
  end;
  Result := not ARectIsSmall;
end;

function cxMakeTextRows(ACanvas: TCanvas;
  AText: PcxCaptionChar;
  const R: TRect; const ATextParams: TcxTextParams; out ATextRows: TcxTextRows;
  out ACount: Integer; AMaxLineCount: Integer = 0): Boolean;
begin
  Result := cxMakeTextRows(ACanvas.Handle, AText, R, ATextParams, ATextRows,
    ACount, AMaxLineCount);
end;

procedure cxPlaceTextRows(AHandle: TCanvasHandle; const R: TRect; var ATextParams: TcxTextParams;
  const ATextRows: TcxTextRows; ARowCount: Integer);

  procedure CalcExtraAndTopRowOffset(out AExtra, ATopRowOffset: Integer);
  var
    H: Integer;
  begin
    AExtra := 0;
    with ATextParams do
    begin
      if (ARowCount > 1) and (TextAlignY = taDistributeY) then
      begin
        H := R.Bottom - R.Top;
        Dec(H, RowHeight);
        if H / (ARowCount - 1) > RowHeight then
        begin
          FullRowHeight := H div (ARowCount - 1);
          AExtra := H mod (ARowCount - 1);
        end;
      end;

      case TextAlignY of
        taCenterY:
          ATopRowOffset := R.Top + (R.Bottom - R.Top - ARowCount * FullRowHeight) div 2;
        taBottom:
          ATopRowOffset := R.Bottom - ARowCount * FullRowHeight + tmExternalLeading;
      else
        ATopRowOffset := R.Top;
      end;

      if PreventTopExceed and (ATopRowOffset < R.Top) then
        ATopRowOffset := R.Top;
    end;
  end;

  procedure PlaceRows(AExtra, ATopRowOffset: Integer);
  var
    I: Integer;
  begin
    for I := 0 to ARowCount - 1 do
      with ATextRows[I] do
      begin
        // Horizontally
        case ATextParams.TextAlignX of
          taCenterX:
            TextOriginX := R.Left + (R.Right - R.Left - TextExtents.cx) div 2;
          taRight:
            TextOriginX := R.Right - TextExtents.cx;
        else
          TextOriginX := R.Left;
        end;
        if ATextParams.PreventLeftExceed and (TextOriginX < R.Left) then
          TextOriginX := R.Left;

        // Vertically
        TextOriginY := ATopRowOffset;
        Inc(ATopRowOffset, ATextParams.FullRowHeight);
        if AExtra > 0 then
        begin
          Inc(ATopRowOffset);
          Dec(AExtra);
        end;
      end;
  end;

var
  Extra, TopRowOffset: Integer;
begin
  CalcExtraAndTopRowOffset(Extra, TopRowOffset);
  PlaceRows(Extra, TopRowOffset);
end;

function cxPrepareRect(const R: TRect; const ATextParams: TcxTextParams;
  ALeftIndent, ARightIndent: Integer): TRect;
begin
  Result := R;
  with Result do
  begin
    Inc(Left, ALeftIndent);
    Dec(Right, ARightIndent);
  end;
end;

function cxUnprepareRect(const R: TRect; const ATextParams: TcxTextParams;