如何在選中時圍繞TImage繪製矩形

我在面板上放置了一組TImage實例。 TImages代表圖標（見附件截圖）。我想在用戶通過點擊選定的TImage實例周圍繪製一個紅色矩形。不知道如何進行...如何在選中時圍繞TImage繪製矩形

編輯：爲什麼我不使用TToolbar？原因1：我不喜歡TToolbar的默認「外觀和感覺」，我希望對它有更多的控制。原因2：這個控件並不是一個真正的TToolbar。它應該被認爲是一種「書籤」元素，它根據選擇的「書籤」在備忘錄字段中顯示不同的文本。

使用雷米勒博的建議接受的解決方案如下：

來源

2016-08-20 BigONotation

把每個放在wincontrol上，例如一個有點擊事件的面板。爲面板提供填充和顏色。 –

如果我是你，我會爲此使用自定義控件。 –

更好的是，使用平坦的工具按鈕或類似的....看起來像一個工具欄。 –

我會建議使用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;

來源

2016-08-20 03:22:23

謝謝！這工作！ – BigONotation

如果你使用TBitmap以外的其他圖形作爲TImage，試圖修改TImage Canvas（'TMyImage.Paint'）不會工作，並且會引發：'只能修改圖像，如果它包含位圖。'你需要修改'繼承'TImage'祖先的Canvas'，即'TGraphicControl.Canvas' – kobik

@kobik好點。我更新了我的例子。 –

-1

我會建議使用TRectangle。您可以通過Fill propery添加位圖（位圖，jpg等），併爲邊框設置Stroke屬性。

您還可以爲圓角邊框設置xRadius和yRadius屬性。

來源

2016-08-20 20:40:00 Edward

如何在選中時圍繞TImage繪製矩形

回答

相關問題