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

Code:

unit Unit1;

{©Drkb v.3}

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.