我在面板上放置了一组TImage实例。 TImages代表图标(参见附件截图)。当用户通过点击它选择它时,我想在给定的TImage实例周围绘制一个红色矩形。不知道如何继续......
编辑:为什么我不使用TToolbar?原因1:我不喜欢TToolbar的默认“外观和感觉”,我想对它有更多的控制权。原因2:此控件实际上不是TToolbar。它应该被视为一种“书签”元素,它根据选择的“书签”在备忘录字段中显示不同的文本。
使用Remy Lebeau建议的公认解决方案如下所示:
我建议使用TPaintBox
而不是TImage
。将您的图像加载到适当的TGraphic
类(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
派生一个新类并覆盖其虚拟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;
我会修改提案。表单上的对象没有问题,键入以下内容:
TImage = class(ExtCtrls.TImage)
private
FShowRectangle: Boolean;
procedure SetShowRectangle(Value: Boolean);
protected
procedure Paint; override;
public
property ShowRectangle: Boolean read FShowRectangle write SetShowRectangle;
end;
我建议使用TRectangle。您可以通过Fill propery添加位图(位图,jpg等)并为边框设置Stroke属性。
您还可以为圆角边框设置xRadius和yRadius属性。