Rounded TPanel in Delphi

Tweet

I came across this rather nice bit code submitted by Andreas Rejbrand on stackoverflow, thought I’d repeat it here. For those not familiar with Delphi, Delphi has really great support for component development, better than any other programming platform I’ve used. The rounded TPanel below is an example of a component, in this case a visual component. One of the key sections is the registration method:

procedure Register;
begin
  RegisterComponents('Rejbrand 2009', [TCustomCaptionPanel]);
end;

that effectively adds the control to the component palette in the IDE. To install into the IDE do the following. Create a new package using the File -> New -> Other menu entry, add the component’s unit to that package, compile and install the package

That is:

1. File | New | Other… | Delphi Projects | Package, click OK
2. Project | Add to Project [add units and/or Requires items]
3. In Project Manager, right-click on Package1.bpl node and select <Install>

Obviously you might want to rename the component something better than Package1. Once installed you’ll find the rounded panel as a component on the component palette.

To use, just drag the rounded panel component from the palette onto your form and bingo you have a rounded panel to play with.

unit CustomCaptionPanel;

interface

uses
  Windows, SysUtils, Classes, Controls, Graphics;

type
  TCustomCaptionPanel = class(TCustomControl)
  private const
    DEFAULT_BORDER_COLOR = $0033CCFF;
    DEFAULT_CLIENT_COLOR = clWindow;
    DEFAULT_BORDER_RADIUS = 16;
  private
    { Private declarations }
    FBorderColor: TColor;
    FClientColor: TColor;
    FBorderRadius: integer;
    FCaption: TCaption;
    FAlignment: TAlignment;
    procedure SetBorderColor(BorderColor: TColor);
    procedure SetClientColor(ClientColor: TColor);
    procedure SetBorderRadius(BorderRadius: integer);
    procedure SetCaption(const Caption: TCaption);
    procedure SetAlignment(Alignment: TAlignment);
  protected
    procedure Paint; override;
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    { Public declarations }
  published
    { Published declarations }
    property Color;
    property Caption read FCaption write SetCaption;
    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
    property Font;
    property BorderColor: TColor read FBorderColor write SetBorderColor default DEFAULT_BORDER_COLOR;
    property ClientColor: TColor read FClientColor write SetClientColor default DEFAULT_CLIENT_COLOR;
    property BorderRadius: integer read FBorderRadius write SetBorderRadius default DEFAULT_BORDER_RADIUS;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Rejbrand 2009', [TCustomCaptionPanel]);
end;

{ TCustomCaptionPanel }

constructor TCustomCaptionPanel.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable, csPannable];
  FBorderColor := DEFAULT_BORDER_COLOR;
  FClientColor := DEFAULT_CLIENT_COLOR;
  FBorderRadius := DEFAULT_BORDER_RADIUS;
  FAlignment := taCenter;
end;

procedure TCustomCaptionPanel.Paint;
var
  r: TRect;
const
  Alignments: array[TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
  inherited;
  Canvas.Pen.Color := FBorderColor;
  Canvas.Brush.Color := FBorderColor;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Rect(FBorderRadius,
    0,
    ClientWidth - FBorderRadius,
    FBorderRadius));
  Canvas.Ellipse(Rect(0,
    0,
    2*FBorderRadius,
    2*FBorderRadius));
  Canvas.Ellipse(Rect(ClientWidth - 2*FBorderRadius,
    0,
    ClientWidth,
    2*FBorderRadius));
  Canvas.Brush.Color := FClientColor;
  Canvas.Rectangle(Rect(0,
    FBorderRadius,
    ClientWidth,
    ClientHeight));
  Canvas.Font.Assign(Self.Font);
  r := Rect(FBorderRadius, 0, ClientWidth - FBorderRadius, FBorderRadius);
  Canvas.Brush.Style := bsClear;
  DrawText(Canvas.Handle,
    PChar(Caption),
    length(Caption),
    r,
    DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS or Alignments[FAlignment]);
end;

procedure TCustomCaptionPanel.SetAlignment(Alignment: TAlignment);
begin
  if FAlignment <> Alignment then
  begin
    FAlignment := Alignment;
    Invalidate;
  end;
end;

procedure TCustomCaptionPanel.SetBorderColor(BorderColor: TColor);
begin
  if FBorderColor <> BorderColor then
  begin
    FBorderColor := BorderColor;
    Invalidate;
  end;
end;

procedure TCustomCaptionPanel.SetBorderRadius(BorderRadius: integer);
begin
  if FBorderRadius <> BorderRadius then
  begin
    FBorderRadius := BorderRadius;
    Invalidate;
  end;
end;

procedure TCustomCaptionPanel.SetCaption(const Caption: TCaption);
begin
  if not SameStr(FCaption, Caption) then
  begin
    FCaption := Caption;
    Invalidate;
  end;
end;

procedure TCustomCaptionPanel.SetClientColor(ClientColor: TColor);
begin
  if FClientColor <> ClientColor then
  begin
    FClientColor := ClientColor;
    Invalidate;
  end;
end;

end.