Solved

Drawing font outline

Posted on 2001-07-09
2
715 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

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

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
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…

739 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