Создание перемещаемых и изменяемых TLabel в VCL для Delphi

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

В этой статье мы рассмотрим, как создать собственный компонент в VCL для Delphi, который позволит пользователям перемещать и изменять размер TLabel. Мы обсудим основные аспекты реализации, включая стилизацию кода, управление ресурсами и улучшение производительности. В конце статьи предложим альтернативные подходы для улучшения функциональности компонента.

Введение

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

Реализация компонента TSizeableLabel

Для начала создадим новый компонент, который будет наследовать от TCustomControl. Это позволит нам использовать все возможности VCL для создания пользовательских элементов управления.

unit SizeableLabel;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TSizeableLabel = class(TCustomControl)
  private
    FInSizingHandle: Boolean;
    FResizeInProgress: Boolean;
    FMoveInProgress: Boolean;
    FHostedLabel: TLabel;
    procedure SetHostedLabel(Value: TLabel);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property HostedLabel: TLabel read FHostedLabel write SetHostedLabel;
  end;

procedure Register;

implementation

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

constructor TSizeableLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHostedLabel := TLabel.Create(Self);
  FHostedLabel.Parent := Self;
  FHostedLabel.Caption := 'Drag me!';
end;

destructor TSizeableLabel.Destroy;
begin
  FHostedLabel.Free;
  inherited;
end;

procedure TSizeableLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FHostedLabel) then
    HostedLabel := nil;
end;

procedure TSizeableLabel.SetHostedLabel(Value: TLabel);
begin
  if (Value = FHostedLabel) then
    Exit;
  if (FHostedLabel <> nil) then
    FHostedLabel.RemoveFreeNotification(Self);
  FHostedLabel := Value;
  if (FHostedLabel <> nil) then
    FHostedLabel.FreeNotification(Self);
end;

procedure TSizeableLabel.Paint;
begin
  inherited;
  if FHostedLabel <> nil then
    FHostedLabel.Repaint;
end;

procedure TSizeableLabel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button = mbLeft then
  begin
    FMoveInProgress := True;
    FInSizingHandle := False;
  end;
end;

procedure TSizeableLabel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if FMoveInProgress then
  begin
    if not FInSizingHandle then
    begin
      Left := Left + X - FHostedLabel.Left;
      Top := Top + Y - FHostedLabel.Top;
      FHostedLabel.Left := X;
      FHostedLabel.Top := Y;
    end;
  end;
end;

procedure TSizeableLabel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  FMoveInProgress := False;
end;

procedure TSizeableLabel.Resize;
begin
  inherited;
  if FHostedLabel <> nil then
  begin
    FHostedLabel.Width := Width;
    FHostedLabel.Height := Height;
  end;
end;

end.

Улучшение кода

В приведенном выше коде мы реализовали базовую функциональность для перемещения и изменения размера TLabel. Однако есть несколько улучшений, которые можно внести:

1. Использование PascalCase для имен переменных и методов: В Delphi принято использовать PascalCase для имен методов и свойств. Это делает код более читаемым и понятным.

2. Инициализация логических переменных: Логические переменные по умолчанию инициализируются значением False, поэтому их явная инициализация не требуется.

3. Управление ресурсами: Мы уже учли это в методе SetHostedLabel, но важно помнить, что компоненты, созданные с использованием Self, будут автоматически уничтожены вместе с родительским компонентом. Это упрощает управление ресурсами и предотвращает утечку памяти.

4. Использование отдельных контролов для хэндов: Anders Melander предложил использовать отдельные контролы для хэндов (грубо говоря, для кнопок изменения размера). Это может упростить управление событиями мыши и рендерингом. Мы можем создать 8 маленьких контролов для каждого хэнда, что сделает код более гибким и модульным.

Пример использования отдельных контролов для хэндов

Для реализации отдельных контролов для хэндов мы можем создать новый компонент, который будет наследовать от TCustomControl и будет отвечать за управление хэндами.

type
  THandleControl = class(TCustomControl)
  private
    FParent: TSizeableLabel;
    FHandleType: THandleType;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent; Parent: TSizeableLabel; HandleType: THandleType); virtual;
    destructor Destroy; override;
  end;

constructor THandleControl.Create(AOwner: TComponent; Parent: TSizeableLabel; HandleType: THandleType);
begin
  inherited Create(AOwner);
  FParent := Parent;
  FHandleType := HandleType;
  OnMouseDown := MouseDown;
  OnMouseMove := MouseMove;
  OnMouseUp := MouseUp;
end;

destructor THandleControl.Destroy;
begin
  inherited;
end;

procedure THandleControl.Paint;
begin
  inherited;
  // Рисуем хэнд, соответствующий типу хэнда
end;

procedure THandleControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button = mbLeft then
    FParent.FInSizingHandle := True;
end;

procedure THandleControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if FParent.FInSizingHandle then
  begin
    // Обработка изменения размера
  end;
end;

procedure THandleControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  FParent.FInSizingHandle := False;
end;

Сохранение состояния TLabel при перезапуске программы

Если необходимо сохранять состояние TLabel (например, его положение и размер) при перезапуске программы, можно использовать механизм сохранения и загрузки данных. Это может быть реализовано с помощью файлов настроек, баз данных или других подходов.

procedure TSizeableLabel.SaveState;
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    IniFile.WriteInteger('Label', 'Left', Left);
    IniFile.WriteInteger('Label', 'Top', Top);
    IniFile.WriteInteger('Label', 'Width', Width);
    IniFile.WriteInteger('Label', 'Height', Height);
  finally
    IniFile.Free;
  end;
end;

procedure TSizeableLabel.LoadState;
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    Left := IniFile.ReadInteger('Label', 'Left', Left);
    Top := IniFile.ReadInteger('Label', 'Top', Top);
    Width := IniFile.ReadInteger('Label', 'Width', Width);
    Height := IniFile.ReadInteger('Label', 'Height', Height);
  finally
    IniFile.Free;
  end;
end;

Заключение

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

Создание таких компонентов позволяет разработчикам создавать более гибкие и интерактивные пользовательские интерфейсы, что особенно полезно для приложений с динамическими интерфейсами.

Создано по материалам из источника по ссылке.

Context представляет собой статью о создании гибкого компонента TSizeableLabel в Delphi, который позволяет пользователю перемещать и изменять размер TLabel, с обсуждением стилей кода, управления ресурсами и альтернативных подходов для улучшения функциона

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

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

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