在Delphi 7中，"TPanel"被圆角化并倾斜。

Question

我想在我的应用程序中使用一个TPanel，但是外观需要有所改变。
因此，我希望拥有一个彩色的标题栏和上角圆角，就像一些用户界面中的它一样。 您知道是否有任何组件或库可以实现？（首选开源，但不仅限于此）
我已经尝试了TJVCaptionPanel，但需要圆形上角。

- philnext

Answer 1

这样呢？

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.

- Andreas Rejbrand

---

很好，它能工作（对D7进行了一些修改）...但是许可证是什么？ - philnext

@philnext：我刚刚写好了。你可以随意使用它。 - Andreas Rejbrand

我认为您在SO上发布的所有内容都将自动成为CC。 - Andreas Rejbrand

我会说：“在像SourceForge这样的开源网站上”。 - philnext

为什么？人们在这里同样可以找到它。 :) 为什么？人们也可以在这里找到它。 :) - Andriy M

@ Andriy：是的...但我喜欢在SourceForge上找到这种代码...如果我有足够的时间，可能会放上去。 - philnext

Answer 2

如果你想要圆角化任何东西，可以试试这个：

procedure RoundCornerOf(Control: TWinControl) ;
var
   R: TRect;
   Rgn: HRGN;
begin
   with Control do
   begin
     R := ClientRect;
     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20) ;
     Perform(EM_GETRECT, 0, lParam(@r)) ;
     InflateRect(r, - 4, - 4) ;
     Perform(EM_SETRECTNP, 0, lParam(@r)) ;
     SetWindowRgn(Handle, rgn, True) ;
     Invalidate;
   end;
end;

- NaN