Rounded and titled “TPanel” in Delphi 7

后端 未结 2 1163
有刺的猬
有刺的猬 2021-02-02 02:31

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 k

相关标签:
2条回答
  • 2021-02-02 02:57

    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.
    

    Screenshot of the custom-caption panel control

    0 讨论(0)
  • 2021-02-02 02:58

    If you wanna round the corner of anything you want, try this:

    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;
    
    0 讨论(0)
提交回复
热议问题