Solved

Text border with TLabel

Posted on 2004-08-13
15
1,766 Views
Last Modified: 2016-01-29
Hello,

I want to have a border around the text of my labels but i don't know how I can..

I've seraching for components but every is shareware and I don't want to pay just for that !!

Can anyone help me ???

Thanks...
0
Comment
Question by:krypto2000
  • 7
  • 3
  • 3
  • +2
15 Comments
 
LVL 17

Expert Comment

by:Wim ten Brink
Comment Utility
Put the label on a palen, align it to client and give the panel the border you need. :-)

Or consider using the TStaticText from the "Additional" controls tab. The StaticText just acts like a label but it happens to have it's own Windows handle.
0
 
LVL 17

Expert Comment

by:Wim ten Brink
Comment Utility
palen=panel :( I cant spell...
0
 

Author Comment

by:krypto2000
Comment Utility
Maybe i've not explain correctly....

I have to take some text under a picture and i want a black border around each char for a better visibility
0
 
LVL 14

Expert Comment

by:Pierre Cornelius
Comment Utility
I'm a bit unclear as to what you want, but based on what I understood, here's something for you to try out:

unit Unit1;

interface

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

type
  TKryptoLabel = class(TLabel)
    private
      FBorderColor: TColor;
      FBorderWidth: integer;
    protected
      procedure SetBorderColor(AValue: TColor);
      procedure SetBorderWidth(AValue: integer);
      procedure Paint; override;
    published
      property BorderColor: TColor read FBorderColor write SetBorderColor;
      property BorderWidth: integer read FBorderWidth write SetBorderWidth;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TKryptoLabel }

procedure TKryptoLabel.Paint;
begin
  inherited;
  Canvas.Brush.Color:= FBorderColor;
  Canvas.Pen.Width:= FBorderWidth;
  Canvas.Polyline([Point(0,0),Point(Width-1,1),
                  Point(Width-1, Height-1),Point(1,Height-1),
                  Point(0,0)]);
end;

procedure TKryptoLabel.SetBorderColor(AValue: TColor);
begin
  if FBorderColor <> AValue then
  begin
    FBorderColor:= AValue;
    Invalidate;
  end;
end;

procedure TKryptoLabel.SetBorderWidth(AValue: integer);
begin
  if FBorderWidth <> AValue then
  begin
    FBorderWidth:= AValue;
    Invalidate;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var kl: TKryptoLabel;
begin
  with TKryptoLabel.Create(self) do
  begin
    parent:= self;
    BorderColor:=clBlue;
    BorderWidth:= 10;
    Caption:= '  Hello Krypto!  ';
    Top:= 20;
    Left:= 20;
    Font.Size:= 30;
    Font.Name:= 'Arial Black';
  end;
end;

end.

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 491
  Height = 229
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
end

You can build on that, re-surface some properties, etc. and register this as a new component.

Regards
Pierre Cornelius
0
 
LVL 17

Expert Comment

by:Wim ten Brink
Comment Utility
Best advise... Use a font that shows characters with a line around them. There are quite a few hollow fonts or boxed fonts available. Both free and commercial...
0
 

Author Comment

by:krypto2000
Comment Utility
Thank you for the code but that is not exactly that I want...
my English is bad and that is hard to explain for me...

I need to have a text border like in photoshop when you apply the "border" style on a text layer... like a outter glow...
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
hello  krypto2000 , , I am not to sure about what look you need for your text output?, but from your description - -
"I have to take some text under a picture and i want a black border around each char for a better visibility"
I am not so sure about better visibility, , , but here is some code for a button Click that will draw Text in a string on a TPaintBox Canvas, with a red border around each charater



procedure TForm1.sbut_DrawBorderTextClick(Sender: TObject);
var
TextStr: String;
StartPos: TPoint;
i, textHeight, textWidth: Integer;
begin
TextStr := 'Bordered Text.';
StartPos.x := 15;
StartPos.y := 31;
PaintBox2.Canvas.Pen.Color := $66DF; // if you want black border change this to Zero
PaintBox2.Canvas.Font.Name := 'Arial';
PaintBox2.Canvas.Brush.Color := $E0FFE0; // background color
textHeight := PaintBox2.Canvas.TextHeight('M');
for i := 1 to Length(TextStr) do
  begin
  textWidth := PaintBox2.Canvas.TextWidth(TextStr[i]);
  PaintBox2.Canvas.Rectangle(StartPos.x-1, StartPos.y-1,StartPos.x+textWidth+4, StartPos.y+textHeight+2);
  Inc(StartPos.x, 2);
  PaintBox2.Canvas.TextOut(StartPos.x, StartPos.y, TextStr[i]);
  Inc(StartPos.x, textWidth+2);
  end;

end;

 - - - - - - - - - - - - - -  - - - - - - - - - - -

this is a method to get bordered text output, I hope you can apply it to what ever display you have.
ask questions if you need more info
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 

Author Comment

by:krypto2000
Comment Utility
Okay.... thank you everybody for your help but I've find a partial solution...
I've found a component "glowLabel" and i've customized it for my application.


----------------------------------------------------------------------------------------

unit kryptoGlowLabel;

// TKryptoGlowLabel component by Krypto
// based on glowLabel component by Ray Konopka

interface

  uses
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    Forms, Dialogs, StdCtrls;

  type
    TKryptoGlowLabel = class( TLabel )
    private
      FGlowColor : TColor;
      FGlowing : boolean;
      procedure DoDrawText(var Rect: TRect; Flags: Word);
    protected
      procedure Paint; override;
      procedure SetGlowColor( Value : TColor );
      procedure SetGlowing(AState: Boolean);
    public
      constructor Create( AOwner : TComponent ); override;
    published
      property GlowColor : TColor read FGlowColor
                                  write SetGlowColor
                                  default clWhite;
      property Glowing : boolean read FGlowing write SetGlowing;
    end;

  procedure Register;

implementation

  constructor TKryptoGlowLabel.Create( AOwner : TComponent );
  begin
    inherited Create( AOwner );
    FGlowing:=false;
    FGlowColor:=clWhite;
  end;

  procedure TKryptoGlowLabel.SetGlowing(AState: Boolean);
  begin
    FGlowing := AState;
    Invalidate;
  end;

  procedure TKryptoGlowLabel.SetGlowColor( Value : TColor );
  begin
    if Value <> FGlowColor then
    begin
      FGlowColor := Value;
      Invalidate;
    end;
  end;

  procedure TKryptoGlowLabel.DoDrawText( var Rect : TRect; Flags : Word );
  var
    Text       : array[ 0..255 ] of Char;
    TmpRect    : TRect;
  begin
    GetTextBuf(Text, SizeOf(Text));
    if ( Flags and DT_CALCRECT <> 0) and
       ( ( Text[0] = #0 ) or ShowAccelChar and
         ( Text[0] = '&' ) and
         ( Text[1] = #0 ) ) then
      StrCopy(Text, ' ');

    if not ShowAccelChar then
      Flags := Flags or DT_NOPREFIX;
    Canvas.Font := Font;

    if FGlowing and Enabled then
    begin
      TmpRect := Rect;
      OffsetRect( TmpRect, 1, 1 );
      Canvas.Font.Color := GlowColor;
      DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);

      TmpRect := Rect;
      OffsetRect( TmpRect, -1, -1 );
      Canvas.Font.Color := GlowColor;
      DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);

      TmpRect := Rect;
      OffsetRect( TmpRect, -1, 1 );
      Canvas.Font.Color := GlowColor;
      DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);

      TmpRect := Rect;
      OffsetRect( TmpRect, 1, -1 );
      Canvas.Font.Color := GlowColor;
      DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);
    end;

    Canvas.Font.Color := Font.Color;
    if not Enabled then
      Canvas.Font.Color := clGrayText;
    DrawText(Canvas.Handle, Text, StrLen(Text), Rect, Flags);
  end;


  procedure TKryptoGlowLabel.Paint;
  const
    Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  var
    Rect: TRect;
  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( Rect, ( DT_EXPANDTABS or DT_WORDBREAK ) or
                  Alignments[ Alignment ] );
    end;
  end;



  procedure Register;
  begin
    RegisterComponents( 'Additional', [ TKryptoGlowLabel ] );
  end;

end.

---------------------------------------------------------------------------------------

this is what I wanted... but not exactly...
I give 150 points for that which find a solution to make me change the color of each char (not glowing color, font color)...

That appears correct to me ;-)
0
 
LVL 33

Accepted Solution

by:
Slick812 earned 150 total points
Comment Utility
I do not think I understand  what you hope we can do with your statement -
"change the color of each char" the font  color
???
are we suppose to have an array of colors where the user must fill in a color for every letter (char) in the text string?
or some other array of colors for the text character color.
or are there two different text colors?
three different text colors?
14 different text colors?

I did some code for two different text colors -


here is some code to do the glowing letter thing

procedure TForm1.sbut_DrawBorderTextClick(Sender: TObject);
var
TextStr: String;
StartPos: TPoint;
TextColor1, TextColor2, GlowColor: Cardinal;
i: Integer;
begin
TextStr := 'Glowwing Text.';
GlowColor := $D0FFFF;
TextColor1 := $FF5500;
TextColor2 := $C0;

StartPos.x := 0;
StartPos.y := 0;
PaintBox2.Canvas.Font.Name := 'Times New Roman';
PaintBox2.Canvas.Font.Size := 18;
PaintBox2.Canvas.Brush.Style := bsClear;

for i := 1 to Length(TextStr) do
  begin
  PaintBox2.Canvas.Font.Color := GlowColor;
  PaintBox2.Canvas.TextOut(StartPos.x, StartPos.y, TextStr[i]);
  PaintBox2.Canvas.TextOut(StartPos.x+2, StartPos.y, TextStr[i]);
  PaintBox2.Canvas.TextOut(StartPos.x+2, StartPos.y+2, TextStr[i]);
  PaintBox2.Canvas.TextOut(StartPos.x, StartPos.y+2, TextStr[i]);
   // the change text color is below
  if (i mod 2 = 0) then
    PaintBox2.Canvas.Font.Color := TextColor1
    else
    PaintBox2.Canvas.Font.Color := TextColor2;

// OR change the .Font.Color to what you happen to need it to be in the next text draw

  PaintBox2.Canvas.TextOut(StartPos.x+1, StartPos.y+1, TextStr[i]);
  Inc(StartPos.x, PaintBox2.Canvas.TextWidth(TextStr[i])+1);
  end;

end;
0
 

Author Comment

by:krypto2000
Comment Utility
I'm sorry for my english...
Thanks Slick812, if you give me these solution at first time I would accept it !
But now I've found a component that i've customized for my use...
If you can, cut & paste the code above and save as unit... after you register it as Component...
The compoment is perfect, but if I can change the font color of each char that will be really perfect !!!!

Example : I would write "Hello" with a glow color black. no problem.
               Now I want to change the color of "H" in red, "e" in yellow, "l" in green  and preserve the glowing effect

I think the best way is to add a method like "KryptoGlowLabel1.setCharColor(color: TColor; index: byte)"

I'm trying this but it's not easly....

So because I'm a little bit over the base question, if you don't find this solution I give you the points ;-)
0
 

Author Comment

by:krypto2000
Comment Utility
I think I can insert your procedure into my component, that will be the must !!!!
0
 

Author Comment

by:krypto2000
Comment Utility
YYEEEEAAAAHHHH !!!! I'VE THE SOLUTION !!!

this is a customized component.... so much customized now this is a new component !!

thanks to Slick812 for the procedure. I have put it into my component...

Now there is the KryptoGlowLabel, with the property "SetCharColor(Value: TColor; Index: Byte)" you can change the
color of each char.

Example : KryptoGlowLabel1.SetCharColor(clRed,0);

that change the first char (index 0) color to red !!!

if you want the complete code of the component tell me and I can send to you....

Thanks everybody !!!
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
I'm glad you got it to Work ! ! You are welcome

as you know, this Experts Exchange is a place for people to come and get  code to help them. . . so I do not need you to send your code to me,

BUT

so others can maybe get help for a problem like yours, , , , , you might post your  Paint  procedure for your new component here on this question, , and any other code that might help them to do this, maybe your  SetCharColor  also.
0
 

Author Comment

by:krypto2000
Comment Utility
Yes ok that's a great idea...
So I give the complete code.. that's more simple :-)
You can register it as component.

==============================================
unit kryptoGlowLabel;

// kryptoGlowLabel component by Krypto
// based on label component by Johnny Mamenko

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TKryptoGlowLabel = class( TLabel )
  private
    FGlowColor:  TColor;
    FGlowing:    boolean;
    FFontColor:  array [0..255] of TColor;
    procedure DoDrawText(var Rect: TRect; Flags: Word);
  protected
    procedure Paint; override;
    procedure SetGlowColor(Value : TColor );
    procedure SetGlowing(AState: Boolean);
  public
    constructor Create( AOwner : TComponent ); override;
  published
    procedure SetCharColor(Value: TColor; Index: Byte);
    property GlowColor : TColor read FGlowColor
                                write SetGlowColor
                                default clWhite;
    property Glowing : boolean read FGlowing write SetGlowing;
  end;

  procedure Register;

implementation

constructor TKryptoGlowLabel.Create( AOwner : TComponent );
var i: integer;
begin
  inherited Create( AOwner );
  FGlowing   := false;
  FGlowColor := clWhite;
  AutoSize   := false;
  for i := 0 to High(FFontColor) do FFontColor[i] := Font.Color;
end;

procedure TKryptoGlowLabel.SetGlowing(AState: Boolean);
begin
  FGlowing := AState;
  Invalidate;
end;

procedure TKryptoGlowLabel.SetGlowColor( Value : TColor );
begin
  if Value <> FGlowColor then
  begin
    FGlowColor := Value;
    Invalidate;
  end;
end;


procedure TKryptoGlowLabel.DoDrawText( var Rect : TRect; Flags : Word );
var startPos: TPoint; i: integer;
begin
   startPos.x  := Rect.Left;
   startPos.y  := Rect.Top;
   Canvas.Font := Font;
   Canvas.Brush.Style := bsClear;

   for i := 1 to Length(Text) do
      begin
      if FGlowing and Enabled then
         begin
         Canvas.Font.Color := GlowColor;
         Canvas.TextOut(StartPos.x+1, StartPos.y,   Text[i]);
         Canvas.TextOut(StartPos.x-1, StartPos.y,   Text[i]);
         Canvas.TextOut(StartPos.x,   StartPos.y+1, Text[i]);
         Canvas.TextOut(StartPos.x,   StartPos.y-1, Text[i]);
         Canvas.TextOut(StartPos.x+1, StartPos.y+1, Text[i]);
         Canvas.TextOut(StartPos.x-1, StartPos.y-1, Text[i]);
         Canvas.TextOut(StartPos.x+1, StartPos.y-1, Text[i]);
         Canvas.TextOut(StartPos.x-1, StartPos.y+1, Text[i]);
         end;

      Canvas.Font.Color := FFontColor[i];
      if not Enabled then Canvas.Font.Color := clGrayText;

      Canvas.TextOut(StartPos.x, StartPos.y, Text[i]);
      Inc(StartPos.x, Canvas.TextWidth(Text[i])+1);
      end;
end;

procedure TKryptoGlowLabel.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Rect: TRect;
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( Rect, ( DT_EXPANDTABS or DT_WORDBREAK ) or
                Alignments[ Alignment ] );
  end;
end;

procedure TKryptoGlowLabel.SetCharColor(Value: TColor; Index: Byte);
begin
   FFontColor[Index+1] := Value;
   Invalidate;
end;

procedure Register;
begin
   RegisterComponents( 'Additional', [ TKryptoGlowLabel ] );
end;

end.
==============================================

Thank you everybody !!
Special thanks to Slick182 !

0
 

Expert Comment

by:Wellington Telles
Comment Utility
I create my own program:

var
  Form1: TForm1;
  TLab : Array[1..5] of TLabel;

procedure TForm1.Button1Click(Sender: TObject);
var

  P    : TPoint;
  af   : Integer; Distance
begin
  P.X := 20;
  P.Y := 20;
  af := 3;

  TLab[1] := TLabel.Create(self);
  with TLab[1] do
  begin
    parent := self;
    Caption := 'Border';
    Font.Color := clBlack;
    Font.Name := 'Tahoma';
    Font.Size := 36;
    Font.Style := [fsBold];
    Transparent := True;
    Left := P.X-af;
    Top := P.Y-af;
  end;

  TLab[2] := TLabel.Create(self);
  with TLab[2] do
  begin
    parent := self;
    Caption := 'Border';
    Font.Color := clBlack;
    Font.Name := 'Tahoma';
    Font.Size := 36;
    Font.Style := [fsBold];
    Transparent := True;
    Left := P.X-af;
    Top := P.y+af;
  end;

  TLab[3] := TLabel.Create(self);
  with TLab[3] do
  begin
    parent := self;
    Caption := 'Border';
    Font.Color := clBlack;
    Font.Name := 'Tahoma';
    Font.Size := 36;
    Font.Style := [fsBold];
    Transparent := True;
    Left := P.X+af;
    Top := P.y+af;
  end;

  TLab[4] := TLabel.Create(self);
  with TLab[4] do
  begin
    parent := self;
    Caption := 'Border';
    Font.Color := clBlack;
    Font.Name := 'Tahoma';
    Font.Size := 36;
    Font.Style := [fsBold];
    Transparent := True;
    Left := P.X+af;
    Top := P.y-af;
  end;

  TLab[5] := TLabel.Create(self);
  with TLab[5] do
  begin
    parent := self;
    Caption := 'Border';
    Font.Color := clLime;
    Font.Name := 'Tahoma';
    Font.Size := 36;
    Font.Style := [fsBold];
    Transparent := True;
    Left := P.X;
    Top := P.y;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  TLab[1].Free;
  TLab[2].Free;
  TLab[3].Free;
  TLab[4].Free;
  TLab[5].Free;
end;
Screen-Shot-01-29-16-at-01.18-PM.PNG
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
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…

762 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

6 Experts available now in Live!

Get 1:1 Help Now