Как нарисовать цветную рамку вокруг поля редактирования с помощью TShape?

Question

Я пытаюсь нарисовать цветную рамку вокруг поля TEdit, используя TShape. Я определяю следующий компонент:

type TGEdit = class(TEdit) 
    private 
    m_shape : TShape; 
    protected 
    procedure setBorderColor(brd_col : TColor); 
    procedure setBorderWidth(brd_wid : integer); 
    public 
    constructor create(AOwner : TComponent); override; 
    destructor destroy(); override; 
    published 
    property borderColor : TColor read m_border_color write setBorderColor default clBlack; 
    property borderWidth : integer read m_border_width write setBorderWidth default 1; 
end; 

Определить объект TShape в конструкторе.

constructor TGEdit.create(AOwner : TComponent); 
begin 
    inherited; 
    Self.BorderStyle:= bsNone; 
    m_border_color := clBlack; 
    m_border_width := 1; 
    m_shape   := TShape.Create(AOwner); 
    m_shape.Parent := Self.Parent; 
    m_shape.Shape := stRectangle; 
    m_shape.Width := Self.Width+2*m_border_width; 
    m_shape.Height := Self.Height+2*m_border_width; 
    m_shape.Left := Self.Left-m_border_width; 
    m_shape.Top  := self.Top-m_border_width; 
    m_shape.Brush.Style := bsClear; 
    m_shape.Pen.Color := m_border_color; 
    m_shape.Pen.Style := psSolid; 
end; 

destructor TGNumberEdit.destroy(); 
begin 
    m_shape.Free(); 
    inherited; 
end; 

определить процедуры для изменения цвета рамки и ширина

procedure TGEdit.setBorderColor(brd_col : TColor); 
begin 
    if m_border_color = brd_col then 
    exit; 
    m_border_color := brd_col; 
    m_shape.Pen.Color := m_border_color; 
end; 

procedure TGEdit.setBorderWidth(brd_wid : integer); 
begin 
    if (m_border_width = brd_wid) or (brd_wid < 0) then 
    exit; 
    m_border_width := brd_wid; 
    m_shape.Pen.Width := m_border_width; 
end; 

Но когда я ставлю компонент на форме Shape не обращается. Где ошибка в моем коде?

Answer 1

TShape является TGraphicControl производным управления, и как таковой никогда не может появиться на вершине TWinControl производного управления, кроме его собственного Parent.

У вашего конструктора TGEdit ошибок. Self.Parent - это ноль в конструкторе, поэтому вы назначаете нуль Parent на TShape, и поэтому он никогда не будет виден.

Если вы хотите TShape иметь такой же Parent как ваш TGEdit, то вам нужно переопределить виртуальный SetParent() метод, который вызывается после завершения строительства. Вы также должны переопределить виртуальный SetBounds() метод, чтобы убедиться, ваши TShape движется вокруг всякий раз, когда ваши TGEdit движется вокруг, например:

type 
    TGEdit = class(TEdit) 
    ... 
    protected 
    ... 
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 
    procedure SetParent(AParent: TWinControl); override; 
    ... 
    end; 

procedure TGEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 
begin 
    inherited; 
    if m_shape <> nil then 
    m_shape.SetBounds(Self.Left - m_border_width, Self.Top - m_border_width, Self.Width + (2*m_border_width), Self.Height + (2*m_border_width)); 
end; 

procedure TGEdit.SetParent(AParent: TWinControl); 
begin 
    inherited; 
    if m_shape <> nil then 
    m_shape.Parent := Self.Parent; 
end; 

Теперь, со всем, что сказал, есть альтернативное решение - вывести свой компонент из TCustomPanel и создать TEdit поверх себя. Вы можете установить цвет панели, границы и т. Д. По мере необходимости.