• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 726
  • Last Modified:

Drawing font outline

Is it possible to draw a font with an outline of different color than the rest of the font?

I know this could be done by drawing the text several times in a slightly different spot with the border color and then on top of that with the main color, but that doesn't always look so good.
0
Keijo
Asked:
Keijo
1 Solution
 
TOndrejCommented:
You can use BeginPath, EndPath, StrokeAndFillPath functions. For demonstration, I've created a small test label, TOutlineLabel with additional published properties OutlineColor, OutlineWidth:

unit OutlineLabel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TOutlineLabel = class(TCustomLabel)
  private
    FOutlineColor: TColor;
    FOutlineWidth: Integer;
    procedure SetOutlineColor(Value: TColor);
    procedure SetOutlineWidth(Value: Integer);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property Caption;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property OutlineColor: TColor read FOutlineColor write SetOutlineColor default clBlack;
    property OutlineWidth: Integer read FOutlineWidth write SetOutlineWidth default 1;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowAccelChar;
    property ShowHint;
    property Transparent;
    property Layout;
    property Visible;
    property WordWrap;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

procedure Register;

implementation

{ TOutlineLabel private }

procedure TOutlineLabel.SetOutlineColor(Value: TColor);
begin
  if FOutlineColor <> Value then
  begin
    FOutlineColor := Value;
    Invalidate;
  end;
end;

procedure TOutlineLabel.SetOutlineWidth(Value: Integer);
begin
  if FOutlineWidth <> Value then
  begin
    FOutlineWidth := Value;
    Invalidate;
  end;
end;

{ TOutlineLabel protected }

procedure TOutlineLabel.Paint;
begin
  if BeginPath(Canvas.Handle) then
  begin
    inherited Paint;
    EndPath(Canvas.Handle);

    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := Font.Color;
    Canvas.Pen.Color := FOutlineColor;
    Canvas.Pen.Width := FOutlineWidth;
    StrokeAndFillPath(Canvas.Handle);
  end
  else
    inherited Paint;
end;

{ TOutlineLabel public }

constructor TOutlineLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOutlineColor := clBlack;
end;

procedure Register;
begin
  RegisterComponents('TOndrej', [TOutlineLabel]);
end;

end.

Example usage:

Create a new application and add a font dialog, a color dialog, and main menu with 3 items:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  Menus, ExtCtrls;

type
  TForm1 = class(TForm)
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    MainMenu1: TMainMenu;
    OutlineFont1: TMenuItem;
    OutlineColor1: TMenuItem;
    OutlineWidth1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure OutlineFont1Click(Sender: TObject);
    procedure OutlineColor1Click(Sender: TObject);
    procedure OutlineWidth1Click(Sender: TObject);
  private
    FLabel: TCustomLabel;
  public
  end;

var
  Form1: TForm1;

implementation

uses
  OutlineLabel;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FLabel := TOutlineLabel.Create(nil);
  with TOutlineLabel(FLabel) do
  begin
    Parent := Self;
    Left := 10;
    Top := 10;
    Alignment := taCenter;
    Transparent := True;
    Font.Name := 'Arial';
    Font.Size := 48;
    Font.Color := clRed;
    Font.Style := [fsBold, fsItalic];
    OutlineColor := clYellow;
    OutlineWidth := 3;
    Caption := 'OutlineLabel1';
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FLabel.Free;
end;

procedure TForm1.OutlineFont1Click(Sender: TObject);
begin
  with FontDialog1 do
  begin
    Font.Assign(TOutlineLabel(FLabel).Font);
    if Execute then
      TOutlineLabel(FLabel).Font.Assign(Font);
  end;
end;

procedure TForm1.OutlineColor1Click(Sender: TObject);
begin
  with ColorDialog1 do
  begin
    Color := TOutlineLabel(FLabel).OutlineColor;
    if Execute then
      TOutlineLabel(FLabel).OutlineColor := Color;
  end;
end;

procedure TForm1.OutlineWidth1Click(Sender: TObject);
var
  S: string;
begin
  S := IntToStr(TOutlineLabel(FLabel).OutlineWidth);
  if InputQuery('', 'Select outline width: ', S) then
    TOutlineLabel(FLabel).OutlineWidth := StrToInt(S);
end;

end.

Notes:

1. This will not work with all fonts, but in general I think that TrueType fonts should be OK. For example, using 'MS Sans Serif' the label draws *nothing* <g>.
2. I didn't register the new label with Delphi so I set all properties in code...
3. The code has not been tested thoroughly, it's intended only for demonstration

Hope this helps, and good luck
TOndrej
0
 
KeijoAuthor Commented:
Thanks, exactly what I was looking for!
0

Featured Post

2018 Annual Membership Survey

Here at Experts Exchange, we strive to give members the best experience. Help us improve the site by taking this survey today! (Bonus: Be entered to win a great tech prize for participating!)

Tackle projects and never again get stuck behind a technical roadblock.
Join Now