Delphi 如何在选定图像时围绕其绘制矩形

我有一组TImage实例被放在面板上。TImages代表图标（请参见随附的屏幕截图）。当用户点击一个给定的TImage实例时，我想在它周围画一个红色的矩形。不知道如何继续

编辑：为什么我不使用TToolbar？理由1：我不喜欢TToolbar默认的“外观”，我想对它有更多的控制。原因2：此控件不是真正的TToolbar。它更应该被视为一种“书签”元素，根据所选的“书签”在备注字段中显示不同的文本

使用Remy Lebeau建议的公认解决方案如下所示：

---

我建议使用

tpaitbox

而不是

TImage

。将图像加载到适当的

t图形

类（

TBitmap

，

TIcon

，

TPNGImage

，等等），然后将其绘制到其

OnPaint

事件中的

TPaintBox

上。这就是

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;

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;

或者，您可以从

TImage

派生一个新类，并重写其虚拟

Paint（）

方法以在默认绘制后绘制矩形。例如：

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;

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;

---

我建议使用

tpaitbox

而不是

TImage

。将图像加载到适当的

t图形

类（

TBitmap

，

TIcon

，

TPNGImage

，等等），然后将其绘制到其

OnPaint

事件中的

TPaintBox

上。这就是

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;

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;

或者，您可以从

TImage

派生一个新类，并重写其虚拟

Paint（）

方法以在默认绘制后绘制矩形。例如：

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;

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;

---

我建议使用三角形。可以通过“填充”属性添加位图（位图、jpg等），并设置边框的笔划属性

---

您还可以为圆角边框设置X半径和Y半径属性。

我建议使用树形角。可以通过“填充”属性添加位图（位图、jpg等），并设置边框的笔划属性

---

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

我会修改这些建议。表单类型上的对象不会有问题，如下所示：

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 = class(ExtCtrls.TImage)
  private
    FShowRectangle: Boolean;
    procedure SetShowRectangle(Value: Boolean);
  protected
    procedure Paint; override;
  public
    property ShowRectangle: Boolean read FShowRectangle write SetShowRectangle;
  end;

---

---

将每个控制器置于一个wincontrol上，例如一个面板，该面板有一个点击事件。为面板提供填充和颜色。如果我是你，我会使用自定义控件。更好的是，使用平面工具按钮或类似的。。。。毕竟看起来像一个工具栏。@SertacAkyuz这是我的第一个想法，但如何使边框变为红色？另外，从技术上讲，没有办法“选择”一个

TImage

-它是一个图形控件，故意设计为不获得焦点。请定义“所选”？你是说当前有焦点的按钮吗？或一个代表当前查看页面的按钮？将每个按钮放在wincontrol上，例如一个有点击事件的面板上。为面板提供填充和颜色。如果我是你，我会使用自定义控件。更好的是，使用平面工具按钮或类似的。。。。毕竟看起来像一个工具栏。@SertacAkyuz这是我的第一个想法，但如何使边框变为红色？另外，从技术上讲，没有办法“选择”一个

TImage

-它是一个图形控件，故意设计为不获得焦点。请定义“所选”？你是说当前有焦点的按钮吗？或表示当前查看页面的按钮？如果您对TImage使用TBitmap以外的图形，请尝试修改TImage画布（在

TMyImage.Paint

）无法工作并将引发：

只能修改包含位图的图像。

您需要修改

TImage

祖先的

继承画布

，即

tgraphic control.Canvas

也无法工作。你需要一块天生的帆布。这有点棘手，因为你需要访问TImage的私人FCanvas…@kobik你说得对。我甚至在之前的一篇文章中也提到了同样的问题，所以我再次更新了我的示例。@RemyLebeau，很好的解决方案类型转换TGraphicControlAccess并访问受保护的画布属性。如果您对TImage使用TBitmap以外的图形，请尝试修改TImage画布（在

TMyImage.Paint

）无法工作并将引发：

只能修改包含位图的图像。

您需要修改

TImage

祖先的

继承画布

，即

tgraphic control.Canvas

也无法工作。你需要一块天生的帆布。这有点棘手，因为你需要访问TImage的私人FCanvas…@kobik你说得对。我甚至在之前的一篇文章中也提到了同样的问题，所以我在这里再次更新了我的示例。@RemyLebeau，这是一个很好的解决方案类型，用于转换TGraphicControlAccess和访问受保护的画布属性。