如何在Delphi中为TLabel文本添加双下划线？

TLabel默认仅支持单下划线，要实现双下划线效果，主要通过自绘文本与下划线的方式来实现，以下是两种实用方案：

方案一：利用OnPaint事件手动绘制 #

适合单个Label快速实现，无需自定义控件：

1. 先设置Label的基础属性：

   • 将Transparent设为True（避免遮挡背景）
   • 保持AutoSize为True（自动适配文本宽度）

2. 为Label添加OnPaint事件，写入以下代码：

procedure TForm1.Label1Paint(Sender: TObject);
var
  TextRect: TRect;
  YPos: Integer;
  TargetLabel: TLabel;
begin
  TargetLabel := TLabel(Sender);
  with TargetLabel.Canvas do
  begin
    // 绘制Label文本
    Font := TargetLabel.Font;
    TextRect := TargetLabel.ClientRect;
    DrawText(Handle, PChar(TargetLabel.Caption), -1, TextRect, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
    
    // 计算第一条下划线的Y坐标（文本基线下方2像素）
    YPos := TextRect.Top + TextHeight(TargetLabel.Caption) + 2;
    
    // 绘制第一条下划线
    Pen.Width := 1;
    Pen.Color := TargetLabel.Font.Color;
    MoveTo(TextRect.Left, YPos);
    LineTo(TextRect.Left + TextWidth(TargetLabel.Caption), YPos);
    
    // 绘制第二条下划线（与第一条间距2像素）
    YPos := YPos + 2;
    MoveTo(TextRect.Left, YPos);
    LineTo(TextRect.Left + TextWidth(TargetLabel.Caption), YPos);
  end;
end;

注意事项： #

• 可通过调整代码中的+2数值，修改两条下划线的间距以及下划线与文本的距离
• 上述代码仅支持单行文本，若需处理多行Label，需调整DrawText的参数（移除DT_SINGLELINE）并循环绘制每行的下划线

方案二：自定义TLabel子类 #

适合需要大量使用双下划线Label的场景，一次定义全局复用：

创建一个新的单元文件，写入以下代码：

unit DoubleUnderlineLabel;

interface

uses
  Vcl.StdCtrls, Vcl.Graphics, Winapi.Windows;

type
  TDoubleUnderlineLabel = class(TLabel)
  protected
    procedure Paint; override;
  end;

implementation

{ TDoubleUnderlineLabel }

procedure TDoubleUnderlineLabel.Paint;
var
  TextRect: TRect;
  YPos: Integer;
begin
  with Canvas do
  begin
    // 绘制文本
    Font := Self.Font;
    TextRect := ClientRect;
    DrawText(Handle, PChar(Caption), -1, TextRect, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
    
    // 计算下划线位置并绘制双线条
    YPos := TextRect.Top + TextHeight(Caption) + 2;
    Pen.Width := 1;
    Pen.Color := Font.Color;
    
    MoveTo(TextRect.Left, YPos);
    LineTo(TextRect.Left + TextWidth(Caption), YPos);
    
    YPos := YPos + 2;
    MoveTo(TextRect.Left, YPos);
    LineTo(TextRect.Left + TextWidth(Caption), YPos);
  end;
end;

end.

使用时，将该单元添加到项目中，即可在代码中创建TDoubleUnderlineLabel实例，或通过组件面板安装后可视化使用，所有该类型的Label都会自动显示双下划线。

内容的提问来源于stack exchange，提问作者Martin Kakhuis