[Страдалецъ]

Вы можете в исходниках, которые идут с Дельфи посмотреть как собственно сам компонент TShape построен. Вот у меня есть самописный компонентик, который реализован по схожему принципу:

Код:

unit DigitSymbol;
 
interface
 
uses
  SysUtils, Classes, Controls, Graphics;
 
type
  TMaskItem = (smTop,smTopRight,smBottomRight,smBottom,smBottomLeft,smTopLeft,smMiddle);
  TSymbolMask = set of TMaskItem;
  TSymbolTemplate = (tmZero,tmOne,tmTwo,tmThree,tmFour,tmFive,tmSix,tmSeven,tmEight,tmNine,tmUser);
 
const
  smZero: TSymbolMask = [smTop,smTopRight,smBottomRight,smBottom,smBottomLeft,smTopLeft];
  smOne: TSymbolMask = [smTopRight,smBottomRight];
  smTwo: TSymbolMask = [smTop,smTopRight,smBottomLeft,smBottom,smMiddle];
  smThree: TSymbolMask = [smTop,smTopRight,smBottomRight,smBottom,smMiddle];
  smFour: TSymbolMask = [smTopRight,smBottomRight,smTopLeft,smMiddle];
  smFive: TSymbolMask = [smTop,smBottomRight,smBottom,smTopLeft,smMiddle];
  smSix: TSymbolMask = [smTop,smBottomRight,smBottom,smTopLeft,smBottomLeft,smMiddle];
  smSeven: TSymbolMask = [smTop,smTopRight,smBottomRight];
  smEight: TSymbolMask = [smTop,smTopRight,smBottomRight,smBottom,smBottomLeft,smTopLeft,smMiddle];
  smNine: TSymbolMask = [smTop,smTopRight,smBottomRight,smBottom,smTopLeft,smMiddle];
 
type
  TDigitSymbol = class(TGraphicControl)
   private
    fTemplate: TSymbolTemplate;
    fMask: TSymbolMask;
    fFillColor: TColor;
    fBorderColor: TColor;
    fBorderWidth: Integer;
    procedure SetSymbolMask(const Value: TSymbolMask);
    procedure SetSymbolTemplate(const Value: TSymbolTemplate);
    procedure SetBorderWidth(const Value: Integer);
    procedure SetColor(Index: Integer; const Value: TColor);
   public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
   published
    property Mask: TSymbolMask read fMask write SetSymbolMask;
    property Template: TSymbolTemplate read fTemplate write SetSymbolTemplate;
    property BorderWidth: Integer read fBorderWidth write SetBorderWidth;
    property FillColor: TColor index 0 read fFillColor write SetColor;
    property BorderColor: TColor index 1 read fBorderColor write SetColor;
  end;
 
procedure Register;
 
implementation
 {$IFNDEF VER150} Uses DesignIntf; {$ENDIF}
 
procedure Register;
begin
 RegisterComponents('Sufferer Components', [TDigitSymbol]);
 {$IFNDEF VER150} 
 RegisterPropertyEditor(TypeInfo(TCursor),TDigitSymbol,'Cursor',nil);
 RegisterPropertyEditor(TypeInfo(THelpType),TDigitSymbol,'HelpType',nil);
 RegisterPropertyEditor(TypeInfo(TCustomHint),TDigitSymbol,'CustomHint',nil);
 RegisterPropertyEditor(TypeInfo(Boolean),TDigitSymbol,'ParentCustomHint',nil);
 RegisterPropertyEditor(TypeInfo(THelpContext),TDigitSymbol,'HelpContext',nil);
 RegisterPropertyEditor(TypeInfo(String),TDigitSymbol,'HelpKeyword',nil);
 RegisterPropertyEditor(TypeInfo(Integer),TDigitSymbol,'Tag',nil);
 {$ENDIF}
end;
 
constructor TDigitSymbol.Create(AOwner: TComponent);
begin
 inherited;
 fMask := smEight;
 fFillColor := clLime;
 fBorderColor := clMoneyGreen;
 fBorderWidth := 1;
 Width := 40;
 Height := 70;
end;
 
procedure TDigitSymbol.Paint;
Var
  Dx,Dy: Integer;
  Brick: TMaskItem;
begin
 inherited;
 Dx := Width div 8;
 Dy := Height div 14;
 Canvas.Pen.Color := fBorderColor;
 Canvas.Pen.Width := fBorderWidth;
 Canvas.Brush.Color := fFillColor;
 for Brick := Low(TMaskItem) to High(TMaskItem)
 do if Brick in Mask then
    case Brick
    of smTop: Canvas.Polygon([Point(Dx*2,0),Point(Dx*6,0),Point(Dx*7,Dy),Point(Dx*6,Dy*2),Point(Dx*2,Dy*2),Point(Dx,Dy)]);
       smTopRight: Canvas.Polygon([Point(Dx*6,Dy*2),Point(Dx*7,Dy),Point(Dx*8,Dy*2),Point(Dx*8,Dy*6),Point(Dx*7,Dy*7),Point(Dx*6,Dy*6)]);
       smBottomRight: Canvas.Polygon([Point(Dx*6,Dy*8),Point(Dx*7,Dy*7),Point(Dx*8,Dy*8),Point(Dx*8,Dy*12),Point(Dx*7,Dy*13),Point(Dx*6,Dy*12)]);
       smBottom: Canvas.Polygon([Point(Dx*2,Dy*12),Point(Dx*6,Dy*12),Point(Dx*7,Dy*13),Point(Dx*6,Dy*14),Point(Dx*2,Dy*14),Point(Dx,Dy*13)]);
       smBottomLeft: Canvas.Polygon([Point(0,Dy*8),Point(Dx,Dy*7),Point(Dx*2,Dy*8),Point(Dx*2,Dy*12),Point(Dx,Dy*13),Point(0,Dy*12)]);
       smTopLeft: Canvas.Polygon([Point(0,Dy*2),Point(Dx,Dy),Point(Dx*2,Dy*2),Point(Dx*2,Dy*6),Point(Dx,Dy*7),Point(0,Dy*6)]);
       smMiddle: Canvas.Polygon([Point(Dx*2,Dy*6),Point(Dx*6,Dy*6),Point(Dx*7,Dy*7),Point(Dx*6,Dy*8),Point(Dx*2,Dy*8),Point(Dx,Dy*7)]);
       end;
end;
 
procedure TDigitSymbol.SetBorderWidth(const Value: Integer);
begin
 if fBorderWidth <> Value
 then begin
      fBorderWidth := Value;
      Invalidate;
      end;
end;
 
procedure TDigitSymbol.SetColor(Index: Integer; const Value: TColor);
begin
 case Index
 of 0: if fFillColor <> Value then fFillColor := Value;
    1: if fBorderColor <> Value then fBorderColor := Value;
    else Exit;
 end;
 Invalidate;
end;
 
procedure TDigitSymbol.SetSymbolMask(const Value: TSymbolMask);
begin
 if fMask <> Value
 then begin
      fMask := Value;
      fTemplate := tmUser;
      if Value = smZero then Template := tmZero;
      if Value = smOne then Template := tmOne;
      if Value = smTwo then Template := tmTwo;
      if Value = smThree then Template := tmThree;
      if Value = smFour then Template := tmFour;
      if Value = smFive then Template := tmFive;
      if Value = smSix then Template := tmSix;
      if Value = smSeven then Template := tmSeven;
      if Value = smEight then Template := tmEight;
      if Value = smNine then Template := tmNine;
      Invalidate;
      end;
end;
 
procedure TDigitSymbol.SetSymbolTemplate(const Value: TSymbolTemplate);
begin
 if Value <> fTemplate
 then begin
      fTemplate := Value;
      case Value
      of tmZero: fMask := smZero;
         tmOne: fMask := smOne;
         tmTwo: fMask := smTwo;
         tmThree: fMask := smThree;
         tmFour: fMask := smFour;
         tmFive: fMask := smFive;
         tmSix: fMask := smSix;
         tmSeven: fMask := smSeven;
         tmEight: fMask := smEight;
         tmNine: fMask := smNine;
         else fTemplate := tmUser;
         end;
      Invalidate;
      end;
end;
 
end.