Using Windows API DrawText with DT_PATH_ELLIPSIS - delphi

Question

I'm trying to use the Windows API function DrawText but don't get the results I expect. Maybe I'm doing something wrong here, but as I read the documentation I really don't see the problem. I'm using the following code.
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 just doesn't seem to do anything. I tried it with DT_END_ELLIPSIS and that gave me some result (see example). When I give the paramater "Text" a string with a backslash (\) in it, it does seem to set the ellipsis but the function ignores the rect measurements.
Example
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

Here's a procedure that draws a string with an ellipsis in the middle if the string is too wide for the given rect:
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;
Here's an example of how its called (PaintBox1 is a 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

Based on #jthurman code
Advantages:
*simplified,
*more universal
*fixes a bug
Enjoy.
{ 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;