cxdrawtextutils.pas

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

  ALeftIndent: Integer = 0; ARightIndent: Integer = 0): TRect;
begin
  Result := R;
  with Result do
  begin
    Dec(Left, ALeftIndent);
    Inc(Right, ARightIndent);
  end;
end;

{$WARNINGS OFF}
procedure cxTextRowsOutHighlight(AHandle: TCanvasHandle; const R: TRect;
  const ATextParams: TcxTextParams; const ATextRows: TcxTextRows; ARowCount,
  ASelStart, ASelLength: Integer; AColor, ATextColor: TColor; AForceEndEllipsis: Boolean);

  procedure OutTextRow(const ATextRow: TcxTextRow);
  var
    Stub: Integer;
  begin
    with ATextRow do
      if ATextParams.ExpandTabs then
      begin
        Stub := 0;
        TabbedTextOut(AHandle, TextOriginX, TextOriginY, Text, TextLength, 0, Stub, TextOriginX);
      end
      else
        TextOut(AHandle, TextOriginX, TextOriginY, Text, TextLength);
  end;

  procedure PrepareEndEllipsis(var ATextRow: TcxTextRow; var AWidth: Integer);
  var
    ACharNumber: Integer;
    ASize: TSize;
  begin
    Dec(AWidth, ATextParams.EndEllipsisWidth);
    if AWidth < 0 then AWidth := 0;
    with ATextRow do
    begin
      if not GetTextExtentExPoint(AHandle, Text, TextLength, AWidth,
        @ACharNumber, nil, ASize) then
          ACharNumber := 0;
      if ACharNumber = 0 then
        ACharNumber := cxStrCharLength(Text);
      TextLength := ACharNumber;
    end;
    cxCalcTextRowExtents(AHandle, ATextRow, ATextParams);
  end;

  procedure OutEndEllipsis(const ATextRow: TcxTextRow; var ARowRect: TRect);
  const
    ClipTexts: array[Boolean] of UINT = (0, ETO_CLIPPED);
  var
    fuOptions: UINT;
  begin
    Inc(ARowRect.Left, ATextRow.TextExtents.cx);
    if ARowRect.Left < ARowRect.Right then
    begin
      fuOptions := ClipTexts[not ATextParams.NoClip and (ARowRect.Left + ATextParams.EndEllipsisWidth > ARowRect.Right)];
      ExtTextOut(AHandle, ARowRect.Left, ATextRow.TextOriginY, fuOptions,
        @ARowRect, PChar(cxEndEllipsisChars),
        Length(cxEndEllipsisChars), nil);
    end;
  end;

  function GetSubstringWidth(AText: PcxCaptionChar; ATextLength, ASubstringLength: Integer): Integer;
  var
    ACharExtents: array of Integer;
    ATextSize: TSize;
  begin
    if ASubstringLength = 0 then
      Result := 0
    else
    begin
      SetLength(ACharExtents, ATextLength);
      GetTextExtentExPoint(AHandle, AText, ATextLength, 0, nil, @ACharExtents[0], ATextSize);
      Result := ACharExtents[ASubstringLength - 1];
    end;
  end;

var
  ARowRect, AHighlightRect: TRect;
  W, I, F, L: Integer;
  ABreakExtra: Integer;
  APrevBkMode: Integer;
  ASaveTextColor: TColor;
  ANeedClip, ANeedEndEllipsis: Boolean;
  ATextRow: TcxTextRow;
  AHighlightStart, AHighlightEnd: Integer;
  ARgn, ASaveClipRgn: HRGN;
  ABrush: HBRUSH;
begin
  AColor := ColorToRGB(AColor);
  ATextColor := ColorToRGB(ATextColor);
  W := R.Right - R.Left;
  ARowRect := R;
  APrevBkMode := SetBkMode(AHandle, Windows.TRANSPARENT);

  if (ASelLength > 0) and (AColor <> clNone) then
    ABrush := CreateSolidBrush(AColor);

  for I := 0 to ARowCount - 1 do
  begin
    ATextRow := ATextRows[I];
    with ATextRow do
    begin
      if TextLength <> 0 then
      begin
        ARowRect.Top := TextOriginY;
        ARowRect.Bottom := ARowRect.Top + ATextParams.FullRowHeight;
        ANeedEndEllipsis := ATextParams.EndEllipsis and (I = ARowCount - 1) and
          ((TextExtents.cx > W) or AForceEndEllipsis);
        ABreakExtra := 0;
        if (ATextParams.TextAlignX in [taJustifyX, taDistributeX]) and not ANeedEndEllipsis then
        begin
          ABreakExtra := W - TextExtents.cX;
          if (BreakCount <> 0) and (ABreakExtra > 0) then
            SetTextJustification(AHandle, ABreakExtra, BreakCount);
        end;

        ANeedClip := not ATextParams.NoClip and ((TextExtents.cX > W) or
          (ARowRect.Top < R.Top) or (ARowRect.Bottom > R.Bottom));
        if ANeedClip then
        begin
          if ARowRect.Top < R.Top then ARowRect.Top := R.Top;
          if ARowRect.Bottom > R.Bottom then ARowRect.Bottom := R.Bottom;
          ARgn := IntersectClipRect(AHandle, ARowRect);
        end;

        if ANeedEndEllipsis then
          PrepareEndEllipsis(ATextRow, W);

        if ASelLength > 0 then
        begin
          if not ((ASelStart >= StartOffset + TextLength) or
            (ASelStart + ASelLength <= StartOffset)) then
          begin
            F := Max(ASelStart, StartOffset);
            L := Min(ASelStart + ASelLength, StartOffset + TextLength);
            Dec(F, StartOffset);
            Dec(L, StartOffset);
            if L > F then
            begin
              AHighlightStart := GetSubstringWidth(Text, TextLength, F);
              AHighlightEnd := GetSubstringWidth(Text, TextLength, L);
              if cxGetWritingDirection(ATextParams.CharSet, Text) = coRightToLeft then
              begin
                AHighlightRect.Left := TextOriginX + TextExtents.cx - AHighlightEnd;
                AHighlightRect.Right := TextOriginX + TextExtents.cx - AHighlightStart;
              end
              else
              begin
                AHighlightRect.Left := TextOriginX + AHighlightStart;
                AHighlightRect.Right := TextOriginX + AHighlightEnd;
              end;
              AHighlightRect.Top := ARowRect.Top;
              AHighlightRect.Bottom := ARowRect.Bottom;
              if not IsRectEmpty(AHighlightRect) then
              begin
                ASaveClipRgn := IntersectClipRect(AHandle, AHighlightRect);
                if AColor <> clNone then
                  FillRect(AHandle, AHighlightRect, ABrush);
                ASaveTextColor := SetTextColor(AHandle, ATextColor);
                OutTextRow(ATextRow);
                SetTextColor(AHandle, ASaveTextColor);
                RestoreClipRgn(AHandle, ASaveClipRgn);
                with AHighlightRect do
                  ExcludeClipRect(AHandle, Left, Top, Right, Bottom);
                if ANeedEndEllipsis and (ASelStart + ASelLength >= StartOffset + TextLength) then
                begin
                  ANeedEndEllipsis := False;
                  ASaveTextColor := SetTextColor(AHandle, ATextColor);
                  OutEndEllipsis(ATextRow, ARowRect);
                  SetTextColor(AHandle, ASaveTextColor);
                end;
              end;
            end;
          end
        end;
        OutTextRow(ATextRow);

        if ANeedEndEllipsis then
          OutEndEllipsis(ATextRow, ARowRect);

        if ANeedClip then
          RestoreClipRgn(AHandle, ARgn);
        if ABreakExtra > 0 then SetTextJustification(AHandle, 0, 0);
      end
      else
        if AForceEndEllipsis and ATextParams.EndEllipsis and (I = ARowCount - 1) then
        begin
          ARowRect.Top := TextOriginY;
          ARowRect.Bottom := ARowRect.Top + ATextParams.FullRowHeight;
          PrepareEndEllipsis(ATextRow, W);
          OutEndEllipsis(ATextRow, ARowRect);
        end;
    end;
  end;

  if (ASelLength > 0) and (AColor <> clNone) then
    DeleteObject(ABrush);
  SetBkMode(AHandle, APrevBkMode);
end;
{$WARNINGS ON}

function cxGetLongestTextRowWidth(const ATextRows: TcxTextRows; ARowCount: Integer): Integer;
var
  I, V: Integer;
begin
  if ARowCount > Length(ATextRows) then ARowCount := Length(ATextRows);
  if ARowCount = 0 then
    Result := 0
  else
  begin
    Result := ATextRows[0].TextExtents.cx;
    for I := 1 to ARowCount - 1 do
    begin
      V := ATextRows[I].TextExtents.cx;
      if V > Result then Result := V;
    end;
  end;
end;

function cxTextOut(AHandle: TCanvasHandle; AText: PcxCaptionChar; var R: TRect;
  AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer;
  AColor, ATextColor: TColor; AMaxLineCount: Integer = 0;
  ALeftIndent: Integer = 0; ARightIndent: Integer = 0): Integer;

  function ProcessText(const ATextParams: TcxTextParams; const ATextRect: TRect): Boolean;
  begin
    if ATextParams.CalcRect then
      Result := (ATextRect.Right - ATextRect.Left) > 0
    else
      Result := not IsRectEmpty(ATextRect);
  end;

var
  ATextHeight, ARowCount, ATextLength: Integer;
  ATextParams: TcxTextParams;
  ATextRect: TRect;
  ATextRows: TcxTextRows;
  AForceEndEllipsis: Boolean;
begin
  Result := 0;
  ATextLength := StrLen(AText);
  if ATextLength = 0 then Exit;
  ATextParams := cxCalcTextParams(AHandle, AFormat);
  ATextRect := cxPrepareRect(R, ATextParams, ALeftIndent, ARightIndent);

  ATextHeight := 0;
  if ProcessText(ATextParams, ATextRect) then
  begin
    ATextRows := nil;
    AForceEndEllipsis := not cxMakeTextRows(AHandle, (AText), ATextRect, ATextParams, ATextRows, ARowCount, AMaxLineCount);
    if ARowCount <> 0 then
    try
      if ATextParams.CalcRect then
      begin
        if (AMaxLineCount > 0) and (AMaxLineCount < ARowCount) then
          ARowCount := AMaxLineCount;
        ATextRect.Right := ATextRect.Left + cxGetLongestTextRowWidth(ATextRows, ARowCount);
        if not ATextParams.SingleLine then
        begin
          ATextRows := nil;
          cxMakeTextRows(AHandle, (AText), ATextRect, ATextParams, ATextRows, ARowCount, AMaxLineCount);
        end;
        cxPlaceTextRows(AHandle, ATextRect, ATextParams, ATextRows, ARowCount);
        ATextRect.Bottom := ATextRows[ARowCount - 1].TextOriginY + ATextParams.RowHeight;
        R := cxUnprepareRect(ATextRect, ATextParams, ALeftIndent, ARightIndent);
      end
      else
      begin
        if (AMaxLineCount > 0) and (ARowCount >= AMaxLineCount) then
        begin
          ARowCount := AMaxLineCount;
          with ATextParams do
            AForceEndEllipsis := AForceEndEllipsis and EndEllipsis and EditControl and not SingleLine;
        end
        else
          AForceEndEllipsis := False;

        cxPlaceTextRows(AHandle, ATextRect, ATextParams, ATextRows, ARowCount);
        if (ASelStart < 0) or (ASelStart >= ATextLength) then
          ASelLength := 0
        else
          if (ASelLength + ASelStart) > ATextLength then
            ASelLength := ATextLength - ASelStart;
        cxTextRowsOutHighlight(AHandle, ATextRect, ATextParams, ATextRows,
          ARowCount, ASelStart, ASelLength, AColor, ATextColor, AForceEndEllipsis);
      end;
      ATextHeight := ATextRows[ARowCount - 1].TextOriginY + ATextParams.RowHeight - ATextRect.Top;
    finally
      ATextRows := nil;
    end;
  end;
  if ATextParams.CalcRowCount or (ATextHeight = 0) then
    Result := ARowCount
  else
    Result := ATextHeight;
end;

function cxTextOut(ACanvas: TCanvas; AText: PcxCaptionChar; var R: TRect;
  AFormat: TcxTextOutFormat; ASelStart, ASelLength: Integer;
  AColor, ATextColor: TColor; AMaxLineCount: Integer = 0;
  ALeftIndent: Integer = 0; ARightIndent: Integer = 0): Integer;
begin
  Result := cxTextOut(ACanvas.Handle, AText, R, AFormat, ASelStart, ASelLength,
    AColor, ATextColor, AMaxLineCount, ALeftIndent, ARightIndent);
end;

function cxTextOut(ACanvas: TCanvas; AText: PcxCaptionChar; var R: TRect;
  AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AMaxLineCount: Integer = 0;
  ALeftIndent: Integer = 0; ARightIndent: Integer = 0): Integer;
begin
  Result := cxTextOut(ACanvas, AText, R, AFormat, 0, 0, ACanvas.Font.Color, clBlack,
    AMaxLineCount, ALeftIndent, ARightIndent);
end;

function cxTextOut(AHandle: TCanvasHandle; AText: PcxCaptionChar; var R: TRect;
  AFormat: TcxTextOutFormat = CXTO_DEFAULT_FORMAT; AMaxLineCount: Integer = 0;
  ALeftIndent: Integer = 0; ARightIndent: Integer = 0): Integer;
begin
  Result := cxTextOut(AHandle, AText, R, AFormat, 0, 0, GetTextColor(AHandle), clBlack,
    AMaxLineCount, ALeftIndent, ARightIndent);
end;

initialization
  cxEndEllipsisCharsLength := Length(cxEndEllipsisChars);

end.