德爾福7中的圓角標題「TPanel」

Question

我在應用程序中有一個TPanel，但有另一個外觀。
爲此，我需要一個彩色標題欄和圓角，就像在某些用戶界面中一樣，如it 您是否知道任何組件或庫？ （首選開源，但不只）。
我試過TJVCaptionPanel沒關係，但需要四捨五入。

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 
    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. 

Screenshot of the custom-caption panel control http://privat.rejbrand.se/customcaptionpanel.png

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;