Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

Расширенный Label для отображения имени файла

Delphi , Компоненты и Классы , TLabel

Расширенный Label для отображения имени файла

Code:

unit Unit1;

interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
 
type
TForm1 = class(TForm)
   Label1: TLabel;
   procedure FormCreate(Sender: TObject);
end;
 
var
Form1: TForm1;
 
implementation
 
uses Types;
 
{$R *.dfm}
 
type
TPathLabel = class(TLabel)
private
   FHintWindow: THintWindow;
   procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
   procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
   procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
   procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;   
protected
   procedure Paint; override;
public
   constructor Create(AOwner: TComponent); override;
end;
 
{ TPathLabel }
 
procedure TPathLabel.CMHintShow(var Message: TMessage);
var
P: TPoint;
R: TRect;
begin
Message.Result := 1;
end;
 
procedure TPathLabel.CMMouseEnter(var Message: TMessage);
var
P: TPoint;
R: TRect;
W: Integer;
begin
W := Canvas.TextWidth(Caption);
if W > ClientWidth then
begin
   P := ClientToScreen(Point(0, 0));
   R := ClientRect;
   R := Rect(P.X, P.Y,
             P.X + W + 5,
             P.Y + ClientHeight);
 
   FHintWindow.ActivateHint(R, Caption);
   Message.Result := 1;
end;
 
inherited;
end;
 
procedure TPathLabel.CMMouseLeave(var Message: TMessage);
begin
FHintWindow.ReleaseHandle;
 
inherited;
end;
 
procedure TPathLabel.CMTextChanged(var Message: TMessage);
begin
if Canvas.TextWidth(Caption) > ClientWidth then
begin
   ShowHint := True;
   Hint := Caption;
end else begin
   ShowHint := False;
   Hint := '';
end;
 
inherited;
end;
 
constructor TPathLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
 
AutoSize := False;
FHintWindow := THintWindow.Create(Self);
FHintWindow.Color := Application.HintColor;
end;
 
procedure TPathLabel.Paint;
var
R: TRect;
begin
R := ClientRect;
if Transparent then
   Canvas.Brush.Style := bsClear
else begin
   Canvas.Brush.Style := bsSolid;
   Canvas.Brush.Color := Color;
end;
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_PATH_ELLIPSIS);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
R: TRect;
begin
R := Label1.BoundsRect;
Inc(R.Top, 50);
Inc(R.Bottom, 50);
with TPathLabel.Create(Self) do
begin
   Parent := Self;
   Color := clLime;
   BoundsRect := R;
   Caption := Label1.Caption;
end;
end;
 
end.
Взято из http://forum.sources.ru

Автор: Smike

Статья Расширенный Label для отображения имени файла раздела Компоненты и Классы TLabel может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: TLabel ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
04.03.2021 05:24:35/0.01591420173645/0