TLabel и TEdit без контейнера

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

При размещении на форме, создается TLabel, расположенный выше поля редактирования. При перемещении поля редактирования, TLabel "следует" за ним. При удалении поля редактирования, TLabel также удаляется. Имеется свойство LabelCaption, так что вы можете редактировать заголовок Tlabel. Вероятно вам потребуются и другие свойства TLabel, типа Font, но этот код только демонстрирует технологию, так что развивайте его по своему усмотрению.

unit LblEdit;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TLabelEdit = class(TEdit)
  private
    FLabel: TLabel;
    procedure WMMove(var Msg: TWMMove); message WM_MOVE;
  protected
    procedure SetParent(Value: TWinControl); override;
    function GetLabelCaption: string; virtual;
    procedure SetLabelCaption(const Value: string); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property LabelCaption: string read GetLabelCaption write
      SetLabelCaption;

  end;

procedure Register;

implementation

constructor TLabelEdit.Create(AOwner: TComponent);

begin
  inherited Create(AOwner);

  { создаем TLabel }
  FLabel := TLabel.Create(nil);
  FLabel.Caption := 'Edit label';
end;

procedure TLabelEdit.SetParent(Value: TWinControl);

begin
  { убеждаемся, что TLabel имеет того же родителя что и TEdit }
  if (Owner = nil) or not (csDestroying in Owner.ComponentState) then
    FLabel.Parent := Value;
  inherited SetParent(Value);
end;

destructor TLabelEdit.Destroy;

begin
  if (FLabel <> nil) and (FLabel.Parent = nil) then
    FLabel.Free;
  inherited Destroy;
end;

function TLabelEdit.GetLabelCaption: string;

begin
  Result := FLabel.Caption;
end;

procedure TLabelEdit.SetLabelCaption(const Value: string);

begin
  FLabel.Caption := Value;
end;

procedure TLabelEdit.WMMove(var Msg: TWMMove);

begin
  inherited;

  { заставляем TLabel 'прилипнуть' к верху TEdit }
  if FLabel <> nil then
    with FLabel do
      SetBounds(Msg.XPos, Msg.YPos - Height, Width, Height);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TLabelEdit]);
end;

initialization
  { Мы используем TLabel, поэтому для обеспечения
  "поточности" необходима регистрация }
  RegisterClass(TLabel);
end.

Это код на Delphi, демонстрирующий создание пользовательского компонента TLabelEdit, который объединяет функциональность TEdit и TLabel. Компонент TLabelEdit автоматически создает TLabel над собой, и когда TEdit перемещается или изменяется размера, TLabel следует за ним. Когда TEdit удаляется, TLabel также удаляется.

Вот разбивка кода:

• Класс TLabelEdit наследуется от TEdit и переопределяет несколько методов для реализации своейcustom-поведки.
• В методе Create создается новый экземпляр класса TLabel и присваивается полю FLabel.
• В методе SetParent обновляется родительский объект TLabel, чтобы он соответствовал родительскому объекту TEdit.
• Методы GetLabelCaption и SetLabelCaption позволяют читать или изменять заголовок TLabel.
• Метод WMMove обновляет позицию TLabel, когда TEdit перемещается.

Процедура Register регистрирует компонент TLabelEdit в палитре компонентов Delphi. Вот что может быть стоить отметки: код не обрабатывает ситуацию, когда пользователь пытается удалить TLabel отдельно от TEdit. В этом случае TLabel будет существовать, но не иметь родителя. Код мог бы быть модифицирован для обработки этой ситуации, проверяя наличие родителя перед попыткой удаления TLabel. В целом, это хороший пример создания пользовательского компонента в Delphi, который объединяет функциональность двух существующих компонентов.

В статье описана технология создания TLabel и TEdit без контейнера, при котором TLabel автоматически перемещается вместе с полем редактирования.

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

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

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