[angvelem]

Я тут на скорую руку состряпял юнит:
stroke.pas

Код:

unit stroke;

interface

uses
  Windows, Messages, Classes, Controls, Graphics, StdCtrls;
  
type
  TCustomStrokeLabel	= class(TCustomLabel)
  private
    fShowAccelChar	: Boolean;
    fAlignment		: TAlignment;
    fLayout		: TTextLayout;
    fWordWrap		: Boolean;
    fPathColor		: TColor;
    procedure SetAlignment(Value : TAlignment);
    procedure SetShowAccelChar(Value : Boolean);
    function  GetPathColor : TColor;
    procedure SetPathColor(aColor : TColor);
  protected
    function  GetLabelText : String ; override;
    procedure DoDrawText(var Rect : TRect; Flags : Longint); override;
    procedure Paint; override;

    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property ShowAccelChar : Boolean read FShowAccelChar write SetShowAccelChar default True;
  public
    constructor Create(AOwner : TComponent); override;
    property PathColor : TColor read GetPathColor write SetPathColor default clRed;
  end;
    
  TStrokeLabel		= class(TCustomStrokeLabel)
  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property Caption;
    property Color nodefault;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PathColor;
    property PopupMenu;
    property ShowAccelChar;
    property ShowHint;
    property Transparent;
    property Layout;
    property WordWrap;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnStartDock;
    property OnStartDrag;
  end;

procedure Register;

implementation

{ TStrokeLabel }

constructor TCustomStrokeLabel.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  fShowAccelChar := True;
  fPathColor := clRed;
end;

function TCustomStrokeLabel.GetLabelText : String;
begin
  Result := Caption;
end;

procedure TCustomStrokeLabel.DoDrawText(var Rect : TRect; Flags : Longint);
var
  Text : String;
begin
  Text := GetLabelText;
  if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and
     (Text[1] = '&') and (Text[2] = #0)) then
    Text := Text + ' ';

  if not FShowAccelChar then
    Flags := Flags or DT_NOPREFIX;

  Flags := DrawTextBiDiModeFlags(Flags);
  Canvas.Font := Font;

  if not Enabled then
  begin
    OffsetRect(Rect, 1, 1);
    Canvas.Font.Color := clBtnHighlight;
    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
    OffsetRect(Rect, -1, -1);
    Canvas.Font.Color := clBtnShadow;
    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  end
  else
  begin
    Canvas.Brush.Style := bsClear;
    Canvas.Pen.Color := fPathColor;
    BeginPath(Canvas.Handle);
    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
    EndPath(Canvas.Handle); 
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := Canvas.Font.Color;
    StrokeAndFillPath(Canvas.Handle);
  end;
end;

procedure TCustomStrokeLabel.Paint;
const
  Alignments : array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps  : array[Boolean] of Word = (0, DT_WORDBREAK);
var
  Rect, CalcRect : TRect;
  DrawStyle      : Longint;
begin
  with Canvas do
  begin
    if not Transparent then
    begin
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
      FillRect(ClientRect);
    end;
    Brush.Style := bsClear;
    Rect := ClientRect;
    { DoDrawText takes care of BiDi alignments }
    DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
    { Calculate vertical layout }
    if FLayout <> tlTop then
    begin
      CalcRect := Rect;
      DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
      if FLayout = tlBottom then
        OffsetRect(Rect, 0, Height - CalcRect.Bottom)
      else
        OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
    end;
    DoDrawText(Rect, DrawStyle);
  end;
end;

procedure TCustomStrokeLabel.SetAlignment(Value : TAlignment);
begin
  if fAlignment <> Value then
  begin
    fAlignment := Value;
    Invalidate;
  end;
end;

procedure TCustomStrokeLabel.SetShowAccelChar(Value : Boolean);
begin
  if FShowAccelChar <> Value then
  begin
    FShowAccelChar := Value;
    Invalidate;
  end;
end;

function TCustomStrokeLabel.GetPathColor : TColor;
begin
  Result := fPathColor;
end;

procedure TCustomStrokeLabel.SetPathColor(aColor : TColor);
begin
  if fPathColor <> aColor then
  begin
    fPathColor := aColor;
    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TStrokeLabel]);
end;

end.

stroke_d7.dpk

Код:

package stroke_d7;

{$ALIGN ON}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'Stroke Label'}
{$IMPLICITBUILD OFF}

requires
  vcl70;

contains
  Stroke in 'Stroke.pas';

end.

stroke_d2009.dpk

Код:

package stroke_d2009;

{$ALIGN ON}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'Stroke Label'}
{$IMPLICITBUILD ON}

requires
  rtl,
  vcl;

contains
  stroke in 'stroke.pas';

end.