Добавление фокуса в TImage (может быть кому-то пригодится)

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Добавление фокуса в TImage (может быть кому-то пригодится)

Сообщение Alex2013 » 29.07.2025 10:52:03

Диалог с deepseek:
Добавление фокуса в TImage в Lazarus
Привет ! Можешь подсказать как снабдить компонент TImage фокусом как у TButton TEdit и TListView в Лазарус ?

К сожалению, стандартный компонент TImage в Lazarus не поддерживает фокус по умолчанию, как TButton, TEdit или TListView. Однако вы можете реализовать эту функциональность несколькими способами:

1. Создание наследника TImage с поддержкой фокуса
pascal
Код: Выделить всё
unit FocusableImage;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, Controls, ExtCtrls;

type
  TFocusableImage = class(TImage)
  private
    FFocusRect: TRect;
    FShowFocus: Boolean;
    procedure SetShowFocus(AValue: Boolean);
  protected
    procedure Paint; override;
    procedure DoEnter; override;
    procedure DoExit; override;
  public
    constructor Create(AOwner: TComponent); override;
    property ShowFocus: Boolean read FShowFocus write SetShowFocus default True;
  end;

implementation

constructor TFocusableImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowFocus := True;
end;

procedure TFocusableImage.SetShowFocus(AValue: Boolean);
begin
  if FShowFocus = AValue then Exit;
  FShowFocus := AValue;
  Invalidate;
end;

procedure TFocusableImage.Paint;
begin
  inherited Paint;
  if FShowFocus and Focused then
  begin
    Canvas.Pen.Color := clHighlight;
    Canvas.Pen.Style := psDot;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(ClientRect);
  end;
end;

procedure TFocusableImage.DoEnter;
begin
  inherited DoEnter;
  Invalidate;
end;

procedure TFocusableImage.DoExit;
begin
  inherited DoExit;
  Invalidate;
end;

end.

2. Использование TPaintBox с обработкой фокуса
pascal
Код: Выделить всё
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  // Рисуем изображение
  if Assigned(Image1.Picture) then
    PaintBox1.Canvas.Draw(0, 0, Image1.Picture.Graphic);
 
  // Рисуем рамку фокуса
  if PaintBox1.Focused then
  begin
    PaintBox1.Canvas.Pen.Color := clHighlight;
    PaintBox1.Canvas.Pen.Style := psDot;
    PaintBox1.Canvas.Brush.Style := bsClear;
    PaintBox1.Canvas.Rectangle(PaintBox1.ClientRect);
  end;
end;

procedure TForm1.PaintBox1Enter(Sender: TObject);
begin
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Exit(Sender: TObject);
begin
  PaintBox1.Invalidate;
end;

3. Использование TPanel с TImage внутри
pascal
Код: Выделить всё
procedure TForm1.Panel1Enter(Sender: TObject);
begin
  Panel1.BevelOuter := bvLowered;
end;

procedure TForm1.Panel1Exit(Sender: TObject);
begin
  Panel1.BevelOuter := bvNone;
end;

Как включить фокус для TImage
Для любого из этих решений вам нужно:

Установить TabStop := True для компонента

Установить правильный TabOrder в последовательности перехода по Tab

Для первого варианта (наследник TImage) после добавления компонента в форму:

pascal
FocusableImage1.TabStop := True;
FocusableImage1.ShowFocus := True;
Выберите подход, который лучше соответствует вашим потребностям. Первый вариант наиболее гибкий и повторно используемый.

Спасибо! Интересно но не проще ли будет использовать что-то вроде "кнопки с картинкой" TSpeedButton или просто вставить Timage в TButton чрез InsertComponent ?

Да, вы совершенно правы! Если вам нужно изображение с возможностью фокуса и реакцией на нажатие, использование TSpeedButton или встраивание TImage в TButton действительно может быть более простым и практичным решением.

1. Использование TSpeedButton (рекомендуемый способ)
TSpeedButton из палитры "Additional" уже поддерживает:

Фокус (с рамкой при получении фокуса)

Клики

Состояния (нажата, активна, etc.)

Картинку (через свойство Glyph)

pascal
Код: Выделить всё
// Простейшая настройка
SpeedButton1.Glyph.LoadFromFile('image.bmp');
SpeedButton1.ShowCaption := False; // Если не нужен текст
SpeedButton1.Flat := False; // Для более "кнопочного" вида
Плюсы:

Уже готовое решение

Поддержка всех стандартных состояний кнопки

Лучшая интеграция с LCL

2. Встраивание TImage в TButton
Это тоже возможно, но требует немного больше работы:

pascal
Код: Выделить всё
procedure TForm1.FormCreate(Sender: TObject);
var
  Img: TImage;
begin
  Img := TImage.Create(Button1);
  Img.Parent := Button1;
  Img.Align := alClient;
  Img.Stretch := True;
  Img.Center := True;
  Img.Picture.LoadFromFile('image.png');
  Button1.Caption := ''; // Убираем текст
end;
Плюсы:

Полноценная кнопка со всеми возможностями

Полный контроль над изображением

Минусы:

Нужно вручную управлять размерами и позиционированием

Могут быть артефакты при изменении размеров

Сравнение подходов
Код: Выделить всё
Критерий           TSpeedButton      TImage в TButton  Кастомный TImage
Простота             ★★★★★              ★★★☆☆       ★★☆☆☆
Гибкость             ★★★☆☆              ★★★★☆       ★★★★★
Внешний вид          ★★★★☆              ★★★★☆       ★★★★★
Готовые состояния    ★★★★★              ★★★★★       ★☆☆☆☆
*Доступность   *В палитре  *Требует кода *Требует компонента


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

Если вы выбрали TSpeedButton, дополнительные улучшения могут включать:

pascal
// Для лучшего отображения
SpeedButton1.Transparent := True;
SpeedButton1.Margin := 0; // Убираем отступы
SpeedButton1.Spacing := 0; // Убираем промежуток между текстом и картинкой


Все это хорош но мучают меня смутные сомнения о том что :
1 Будет ли TSpeedButton достаточно похож на TImage, что бы не портить вид приложения?
2 И будет ли (кроме вышесказанного) в варианте "TImage в TButton" (мне он нравится больше всего ) надежная прорисовка картинки?
Вообще буду пробовать .
Alex2013
долгожитель
 
Сообщения: 3154
Зарегистрирован: 03.04.2013 11:59:44

Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex [Bot] и гости: 248

Рейтинг@Mail.ru