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);
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);
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.
Автор: Smike
Статья Расширенный Label для отображения имени файла раздела Компоненты и Классы TLabel может быть полезна для разработчиков на Delphi и FreePascal.
