Не рисуется компонента, и все тут...

← →
Aleksandr (2001-12-18 13:03) [0]

Уважаемые коллеги!
Понадобилось это мне создать компоненту. Создал, породив от TGraphicControl. Ставлю на форму - все в порядке, проперти видны, но вот не рисуется, и все тут... Код таков

type
TWayTree = class(TGraphicControl)
private
...
protected
procedure Paint;override;
public
constructor Create(AOwner : TComponent);
published
...
property Color default clWhite;
property Visible default true;
end;

procedure Register;

implementation

procedure TWayTree.Paint;
var
ARect : TRect;
begin
Inherited;
Canvas.Brush.Color:=Color;
ARect.Left:=Left;
ARect.Top:=Top;
ARect.Bottom:=Top+Height;
ARect.Right:=Left+Width;
Canvas.FillRect(ARect)
end;

constructor TWayTree.Create;
begin
Inherited Create(AOwner);
...
end;

procedure Register;
begin
RegisterComponents("WayTrees", [TWayTree])
end;

end.

Мало того, когда я еще пытаюсь добавить свойства FPen и FBrush (для отдельного доступа в дизайн-тайме):

TWayTree = class(TGraphicControl)
private
FPen : TPen;
FBrush : TBrush;
procedure RePaintRequest(Sender : TObject);
procedure SetBrush(Value : TBrush);
procedure SetPen(Value : TPen);
protected
procedure Paint;override;
public
constructor Create(AOwner : TComponent);
destructor Destroy;
published
property Color default clWhite;
property Visible;
property Brush : TBrush read FBrush write SetBrush;
property Pen : TPen read FPen write SetPen;
end;

procedure Register;

implementation

procedure TWayTree.Paint;
var
ARect : TRect;
begin
Inherited;
Canvas.Pen:=FPen;
Canvas.Brush:=FBrush;
Canvas.Brush.Color:=Color;
ARect.Left:=Left;
ARect.Top:=Top;
ARect.Bottom:=Top+Height;
ARect.Right:=Left+Width;
Canvas.FillRect(ARect);
Canvas.TextOut(ARect.Left,ARect.Top,"AAA");
end;

destructor TWayTree.Destroy;
begin
FPen.Free;
FBrush.Free;
inherited Destroy
end;

constructor TWayTree.Create;
begin
Inherited Create(AOwner);
FPen:=TPen.Create;
FBrush:=TBrush.Create;
FPen.OnChange:=RepaintRequest;
FBrush.OnChange:=RepaintRequest
end;

procedure TWayTree.SetBrush;
begin
if Value=nil then
Exit;
FBrush.Assign(Value);
Invalidate
end;

procedure TWayTree.SetPen;
begin
if Value=nil then
Exit;
FPen.Assign(Value);
Invalidate
end;

procedure TWayTree.RePaintRequest;
begin
Invalidate
end;

procedure Register;
begin
RegisterComponents("WayTrees", [TWayTree]);
end;

end.
компонента при вставлении в форму ругается, что не может установить Pen в nil. Pen и Brush в Инспекторе появляются, но при нажатии на + нифига не выпадает, при изменении размеров компоненты та же ошибка... Чего я тут не так делаю?

Не рисуется компонента, и все тут... Найти похожие ветки