选择时如何在 TImage 周围绘制矩形

Question

我在面板上布置了一组 TImage 实例。 TImages 代表图标（见附件截图）。当用户通过单击选择它时，我想在给定的 TImage 实例周围绘制一个红色矩形。不确定如何进行...

编辑：为什么我不使用 TToolbar？原因 1：我不喜欢 TToolbar 的默认 "look and feel"，我想对其进行更多控制。原因 2：这个控件不是真正的 TToolbar。它应该被视为一种 "bookmark" 元素，它根据选择的 "bookmark" 在备注字段中显示不同的文本。

接受 Remy Lebeau 建议的解决方案如下所示：

Answer 1

我建议使用 TPaintBox 而不是 TImage。将您的图像加载到适当的 TGraphic class（TBitmap、TIcon、TPNGImage 等），然后将其绘制到 TPaintBox OnPaint 事件。这就是一个 TImage 真正做的（它拥有一个 TGraphic，在绘制时绘制到它的 Canvas 上）。然后，您可以在需要时在图像顶部绘制一个红色矩形。例如：

procedure TMyForm.PaintBox1Click(Sender: TObject);
begin
  PaintBox1.Tag := 1;
  PaintBox1.Invalidate;
  PaintBox2.Tag := 0;
  PaintBox2.Invalidate;
end;

procedure TMyForm.PaintBox2Click(Sender: TObject);
begin
  PaintBox1.Tag := 0;
  PaintBox1.Invalidate;
  PaintBox2.Tag := 1;
  PaintBox2.Invalidate;
end;

procedure TMyForm.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(MyImage1, 0, 0);
  if PaintBox1.Tag = 1 then
  begin
    PaintBox1.Canvas.Brush.Style := bsClear;
    PaintBox1.Canvas.Pen.Color := clRed;
    PaintBox1.Canvas.Rectangle(PaintBox1.ClientRect);
  end;
end;

procedure TMyForm.PaintBox2Paint(Sender: TObject);
begin
  PaintBox2.Canvas.Draw(MyImage2, 0, 0);
  if PaintBox2.Tag = 1 then
  begin
    PaintBox2.Canvas.Brush.Style := bsClear;
    PaintBox2.Canvas.Pen.Color := clRed;
    PaintBox2.Canvas.Rectangle(PaintBox2.ClientRect);
  end;
end;

或者，您可以从 TImage 派生一个新的 class 并覆盖其虚拟 Paint() 方法以在默认绘制后绘制矩形。例如：

type
  TMyImage = class(TImage)
  private
    FShowRectangle: Boolean;
    procedure SetShowRectangle(Value: Boolean);
  protected
    procedure Paint; override;
  public
    property ShowRectangle: Boolean read FShowRectangle write SetShowRectangle;
  end;

procedure TMyImage.SetShowRectangle(Value: Boolean);
begin
  if FShowRectangle <> Value then
  begin
    FShowRectangle := Value;
    Invalidate;
  end;
end;

type
  TGraphicControlAccess = class(TGraphicControl)
  end;

procedure TMyImage.Paint;
begin
  inherited;
  if FShowRectangle then
  begin
    with TGraphicControlAccess(Self).Canvas do
    begin
      Brush.Style := bsClear;
      Pen.Color := clRed;
      Rectangle(ClientRect);
    end;
  end;
end;

procedure TMyForm.MyImage1Click(Sender: TObject);
begin
  MyImage1.ShowRectangle := true;
  MyImage2.ShowRectangle := false;
end;

procedure TMyForm.MyImage2Click(Sender: TObject);
begin
  MyImage1.ShowRectangle := false;
  MyImage2.ShowRectangle := true;
end;

Answer 2

我建议使用 TRectangle。您可以通过填充属性添加位图（位图、jpg 等）并为边框设置描边属性。

您还可以为圆角边框设置 xRadius 和 yRadius 属性。

Answer 3

我会修改提案。表单上的对象不会有问题，请键入以下内容：

TImage = class(ExtCtrls.TImage)
  private
    FShowRectangle: Boolean;
    procedure SetShowRectangle(Value: Boolean);
  protected
    procedure Paint; override;
  public
    property ShowRectangle: Boolean read FShowRectangle write SetShowRectangle;
  end;

选择时如何在 TImage 周围绘制矩形

How to draw a rectangle around a TImage when it is selected

delphi

lazarus