使用带有 DT_PATH_ELLIPSIS 的 Windows API DrawText

Question

我正在尝试使用 Windows API 函数DrawText，但没有得到我期望的结果。也许我在这里做错了什么，但是当我阅读文档时，我真的没有看到问题。我正在使用以下代码。

function GetEllipsisString(Font: TFont; const Text: string; 
  Width: integer): String;
var
  DC: HDC;
  SaveFont: HFont;
  R: TRect;
begin
  DC := GetDC(0);
  try
    SaveFont := SelectObject(DC, Font.Handle);
    R := Rect (0, 0, Width-1, 0);
    Result := Text+'    ';
    Winapi.Windows.DrawtextW (DC, PChar(Result), Length(Result), R,
      DT_CALCRECT+DT_LEFT+DT_PATH_ELLIPSIS+DT_MODIFYSTRING);
    SelectObject(DC, SaveFont);
  finally
    ReleaseDC(0, DC);
  end;
end;

DT_PATH_ELLIPSIS 似乎什么也没做。我用 DT_END_ELLIPSIS 进行了尝试，这给了我一些结果（参见示例）。当我给参数“Text”一个带有反斜杠（\）的字符串时，它似乎设置了省略号，但该函数忽略了矩形测量值。

示例

Text = 'This text has to many characters to fit.'
DT_END_ELLIPSIS returns 'This text has to m...'#0'characters to fit.    '
DT_PATH_ELLIPSIS returns 'This text has to many characters to fit.    '

Answer 1

如果字符串对于给定的矩形来说太宽，这里会绘制一个中间带有省略号的字符串：

procedure DrawTextWithMiddleEllipsis(Canvas: TCanvas; Text: string; DrawRect:
   TRect; Flags: Integer);
var
  S, LastS: string;
  R: TRect;
  Sz: TSize;
  RectWidth, I: Integer;
begin
  S := Text;
  R := DrawRect;
  GetTextExtentPoint32(Canvas.Handle, S, Length(S), Sz);
  RectWidth := DrawRect.Right - DrawRect.Left;
  if Sz.cx > RectWidth then
  begin
    //The string is too wide. Need to cut it down with ellipsis
    //Start with the smallest possible truncated-and-ellipsis-modified string,
    //and expand until we have the biggest one that can fit
    S := '...';
    for I := 1 to Length(Text) div 2 do
    begin
      LastS := S;
      //Get the first I chars, then the ellipsis, then the last I chars
      S := Copy(Text, 1, I) + '...' + Copy(Text, Length(Text) - I + 1, I);
      GetTextExtentPoint32(Canvas.Handle, S, Length(S), Sz);
      if Sz.cx > RectWidth then
      begin
        DrawText(Canvas.Handle, LastS, Length(LastS), DrawRect, Flags);
        Break;
      end;
    end;
  end else
    //The string will fit in the width of the given rect, don't mess with it
    DrawText(Canvas.Handle, S, Length(S), DrawRect, Flags);
end;

这是一个如何调用它的示例（PaintBox1 是 TPaintBox）：

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  S: string;
  R: TRect;
begin
  S := 'This is extra long text that should overflow';
  R := PaintBox1.ClientRect;
  DrawTextWithMiddleEllipsis(PaintBox1.Canvas, S, R, DT_LEFT or DT_TOP);
end;

Answer 2

基于@jthurman 代码

优点：
*简化，
*更通用
*修复一个错误

享受吧。

 { Takes a long string and truncates it in the middle. Example: '123...789'  }
 function GetEllipsisText(CONST s: string; Canvas: TCanvas; MaxWidth:    Integer; Flags: Integer= DT_LEFT or DT_TOP): string;
var
 NewStr, LastStr: string;
 TextSize: TSize;
 EllipsisSize: Integer;
begin
 NewStr := '...';
 EllipsisSize:= Canvas.TextWidth(NewStr);

 GetTextExtentPoint32(Canvas.Handle, s, Length(s), TextSize);
 if TextSize.cX > MaxWidth
 then
   //Start with the smallest possible truncated-and-ellipsis-modified string, and expand until we have the biggest one that can fit
   for VAR i:= 1 to Length(s) div 2 do
    begin
       LastStr := NewStr;
       NewStr := Copy(s, 1, I) + '...' + Copy(s, Length(s) - I + 1, I);   // Get the first I chars, then the ellipsis, then the last I chars
       GetTextExtentPoint32(Canvas.Handle, NewStr, Length(NewStr), TextSize);
       if TextSize.cx > (MaxWidth - EllipsisSize)
       then Exit(LastStr);
    end
else
   Result:= s;   //The string will fit in the width of the given rect, don't mess with it
end;