How to make TFrame with rounded corners?

后端 未结 1 1152
感情败类
感情败类 2021-01-31 11:58

I want to make a component based on a TFrame with TLMDShapeControl (for drawing round corner background) and a TEdit control (that can be

相关标签:
1条回答
  • 2021-01-31 12:53

    To answer your question how to make frame with rounded corners you can try something like this, but you will be dissatisfied with the result since the CreateRoundRectRgn used here has no antialiasing.

    type
      TFrame1 = class(TFrame)
        Edit1: TEdit;
        Button1: TButton;
      protected
        procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
      end;
    
    implementation
    
    procedure TFrame1.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    var
      Region: HRGN;
    begin
      inherited;
      Region := CreateRoundRectRgn(0, 0, ClientWidth, ClientHeight, 30, 30);
      SetWindowRgn(Handle, Region, True);
    end;
    

    Update:

    Since GDI doesn't have any function that would support antialiasing for arc rendering, I've posted here an example of a round rectangle shape (just a pure filled round rectangle) that uses GDI+ (for this you will need GDI+ wrappers from here).

    The following properties are important for its use:

    • Color - is the shape fill color (can be enhanced of pen color, gradient etc.)
    • Radius - is the radius (in pixels) of the circle used to draw the rounded corners
    • AlphaValue - is the opacity value of the rendered round rectangle (just for fun :-)

    unit RoundShape;
    
    interface
    
    uses
      SysUtils, Classes, Controls, Graphics, GdiPlus;
    
    type
      TCustomRoundShape = class(TGraphicControl)
      private
        FRadius: Integer;
        FAlphaValue: Integer;
        procedure SetRadius(Value: Integer);
        procedure SetAlphaValue(Value: Integer);
      protected
        procedure Paint; override;
        property Radius: Integer read FRadius write SetRadius default 10;
        property AlphaValue: Integer read FAlphaValue write SetAlphaValue default 255;
      public
        constructor Create(AOwner: TComponent); override;
      end;
    
      TRoundShape = class(TCustomRoundShape)
      public
        property Canvas;
      published
        property Align;
        property AlphaValue;
        property Anchors;
        property Color;
        property Constraints;
        property DragCursor;
        property DragKind;
        property DragMode;
        property Enabled;
        property Font;
        property ParentColor;
        property ParentFont;
        property ParentShowHint;
        property PopupMenu;
        property Radius;
        property ShowHint;
        property Visible;
        property OnClick;
        property OnContextPopup;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDock;
        property OnEndDrag;
        property OnMouseActivate;
        property OnMouseDown;
        property OnMouseEnter;
        property OnMouseLeave;
        property OnMouseMove;
        property OnMouseUp;
        property OnStartDock;
        property OnStartDrag;
      end;
    
    procedure Register;
    
    implementation
    
    { TCustomRoundShape }
    
    constructor TCustomRoundShape.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      Width := 213;
      Height := 104;
      FRadius := 10;
      FAlphaValue := 255;
    end;
    
    procedure TCustomRoundShape.SetRadius(Value: Integer);
    begin
      if FRadius <> Value then
      begin
        FRadius := Value;
        Invalidate;
      end;
    end;
    
    procedure TCustomRoundShape.SetAlphaValue(Value: Integer);
    begin
      if FAlphaValue <> Value then
      begin
        FAlphaValue := Value;
        Invalidate;
      end;
    end;
    
    procedure TCustomRoundShape.Paint;
    var
      GPPen: TGPPen;
      GPColor: TGPColor;
      GPGraphics: IGPGraphics;
      GPSolidBrush: IGPSolidBrush;
      GPGraphicsPath: IGPGraphicsPath;
    begin
      GPGraphicsPath := TGPGraphicsPath.Create;
      GPGraphicsPath.Reset;
      GPGraphicsPath.AddArc(0, 0, FRadius, FRadius, 180, 90);
      GPGraphicsPath.AddArc(ClientWidth - FRadius - 1, 0, FRadius, FRadius, 270, 90);
      GPGraphicsPath.AddArc(ClientWidth - FRadius - 1, ClientHeight - FRadius - 1,
        FRadius, FRadius, 0, 90);
      GPGraphicsPath.AddArc(0, ClientHeight - FRadius - 1, FRadius, FRadius, 90, 90);
      GPGraphicsPath.CloseFigure;
    
      GPColor.InitializeFromColorRef(ColorToRGB(Color));
      GPColor.Alpha := FAlphaValue;
      GPPen := TGPPen.Create(GPColor);
      GPSolidBrush := TGPSolidBrush.Create(GPColor);
    
      GPGraphics := TGPGraphics.Create(Canvas.Handle);
      GPGraphics.SmoothingMode := SmoothingModeAntiAlias;
      GPGraphics.FillPath(GPSolidBrush, GPGraphicsPath);
      GPGraphics.DrawPath(GPPen, GPGraphicsPath);
    end;
    
    procedure Register;
    begin
      RegisterComponents('Stack Overflow', [TRoundShape]);
    end;
    
    end.
    

    And the result (with SmoothingModeAntiAlias smoothing mode applied):

    enter image description here

    One can say it's a big overhead to use GDI+ for such tiny thing but pure GDI render without antialiasing what makes the results looks ugly. Here is the example of the same round rectangle rendered by using pure GDI:

    enter image description here

    0 讨论(0)
提交回复
热议问题