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
Перевод контента на русский язык:
Это код Delphi, который создает пользовательский контроль для метки с расширенными функциями для отображения имен файлов с подсказками (tool tips) при наведении мыши на нее.
Распределение кода:
Класс TPathLabel наследуется от TLabel и переопределяет несколько методов для реализации своейcustom-поведки.
В конструкторе Create, он настраивает окно подсказок (FHintWindow) и initializes некоторые свойства (например, AutoSize, Color).
В методе CMHintShow, он включает подсказку для метки, установив Result в 1.
В методе CMMouseEnter, он проверяет, превышает ли ширина текста заголовка ширину клиента, и если да, то активирует окно подсказок с текстом заголовка.
В методе CMMouseLeave, он освобождает handle окна подсказок при уходе мыши от метки.
В методе CMTextChanged, он обновляет свойство show hint, основываясь на том, превышает ли ширина текста заголовка ширину клиента.
Процедура FormCreate в форме создает экземпляр пользовательского класса TPathLabel и настраивает его свойства (например, Parent, Color, Caption) для создания метки с указанным цветом, прямоугольником ограничения и заголовком. Метка затем добавляется в форму.
В планах по улучшению можно рассмотреть добавление следующих функциональных возможностей:
Разрешение настройки свойств окна подсказок (например, шрифт, цвет)
Реализация эффекта fade-in/fade-out для окна подсказок
Добавление поддержки нескольких строк текста
Улучшение логики рисования в Paint для улучшения качества отображения
В целом, этот код предоставляет хороший старт для создания пользовательских контролов меток с advanced-функциональностью.
В статье описывается создание расширенного Label для отображения имени файла с функцией подсказки имени файла при наведении на него.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал