Solved

Drawing font outline

Posted on 2001-07-09
2
710 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
Comment Utility
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
Comment Utility
Thanks, exactly what I was looking for!
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
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…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

772 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now