Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Text border with TLabel

Posted on 2004-08-13
15
Medium Priority
?
2,065 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
[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
  • 7
  • 3
  • 3
  • +2
15 Comments
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 11793219
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
ID: 11793230
palen=panel :( I cant spell...
0
 

Author Comment

by:krypto2000
ID: 11793281
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 14

Expert Comment

by:Pierre Cornelius
ID: 11793876
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
ID: 11794218
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
ID: 11807410
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 34

Expert Comment

by:Slick812
ID: 11813960
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
 

Author Comment

by:krypto2000
ID: 11818050
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 34

Accepted Solution

by:
Slick812 earned 600 total points
ID: 11826540
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
ID: 11828045
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
ID: 11828325
I think I can insert your procedure into my component, that will be the must !!!!
0
 

Author Comment

by:krypto2000
ID: 11828815
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 34

Expert Comment

by:Slick812
ID: 11835365
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
ID: 11838564
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
ID: 41439693
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

Ask an Anonymous Question!

Don't feel intimidated by what you don't know. Ask your question anonymously. It's easy! Learn more and upgrade.

Question has a verified solution.

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

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…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Is your data getting by on basic protection measures? In today’s climate of debilitating malware and ransomware—like WannaCry—that may not be enough. You need to establish more than basics, like a recovery plan that protects both data and endpoints.…
Suggested Courses

618 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