Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to make TFrame with rounded corners?

I want to make a component based on a TFrame with TLMDShapeControl (for drawing round corner background) and a TEdit control (that can be also a TComboBox or a TDBEdit and so on). After that I will use the "Add to Palette" command to turn it into a Reusable Component Control.

The problem in that I need it to be width flexible and for that I had the idea of turn everything inside the Frame alClient and the TEdit with 5 pixel margin so the user can see the rounded corners.

It was terrible because I can't use Align and set components one in the top of another. Now I have to copy and paste the components on every time I have to use it! :-(((

The only way I see the right thing is to use only the TEdit with alClient and 5px margin and no TShape. Instead I could make the TFrame to be rounded corner with transparency, so it won't look ugly on of different colors or TImages.

But how do I do that?

Does anyone have any code sample?

this is the goal: transparent rounded corners

like image 780
NaN Avatar asked Jul 26 '12 18:07

NaN


1 Answers

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

like image 178
TLama Avatar answered Sep 28 '22 11:09

TLama