Rounded and titled "TPanel" in Delphi 7

Question

I would have a TPanel in my application but with another look.
For it I want a colored title bar and the up corner rounded just like in some user interfaces like it Do you know any component or library for it ? (Prefered Open source but not only).
I tried TJVCaptionPanel it's OK but needs rounded up corner.

Answer 1

Like this?

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
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  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.