Solved

Drawing font outline

Posted on 2001-07-09
2
712 Views
Last Modified: 2013-12-02
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
Comment
Question by:Keijo
2 Comments
 
LVL 8

Accepted Solution

by:
TOndrej earned 100 total points
ID: 6265569
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
 

Author Comment

by:Keijo
ID: 6268121
Thanks, exactly what I was looking for!
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
FMX enumerated colours 2 102
Delphi: ForceDirectory plain function 7 35
CheckListBox usage 3 60
Multi-layered image in FireMonkey 9 39
A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

825 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question