«« Site Rescued »»

While the site is still going to move from its current host, a new site will now take its place. More Info.

The new site may have less content, but the core will now remain. And it will now play nicely with phones! Keep an eye on the DelphiDabbler Blog for news.

» Help

How to change the corner size of RoundRect

   
Question
The RoundRect shape has too much space missing in the corners. I'd like to specify a smaller corner ellipse. Is there any way to make the rounding of the corners more subtle by using the Delphi shape, or do I have to resort to writing to the WinAPI?

Here is one that will let you change the size of the corners.

unit NewShape;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls;

type
  TNewShape = class(TShape)
  private
    FCornerSize: Integer;
    procedure SetCornerSize(Value: Integer);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property CornerSize: Integer
      read FCornerSize write SetCornerSize default 2;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TNewShape]);
end;

constructor TNewShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCornerSize := 2;
end;

procedure TNewShape.Paint;
var
  X, Y, W, H, S: Integer;
begin
  with Canvas do
  begin
    X := Pen.Width div 2;
    Y := X;
    W := Width - Pen.Width + 1;
    H := Height - Pen.Width + 1;
    if Pen.Width = 0 then
    begin
      Dec(W);
      Dec(H);
    end;
    if W < H then
      S := W
    else
      S := H;
    if Shape in [stSquare, stRoundSquare, stCircle] then
    begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;
    case Shape of
      stRectangle, stSquare:
        Rectangle(X, Y, X + W, Y + H);
      stRoundRect, stRoundSquare:
        RoundRect(X, Y, X + W, Y + H, FCornerSize, FCornerSize);
      stCircle, stEllipse:
        Ellipse(X, Y, X + W, Y + H);
    end;
  end;
end;

procedure TNewShape.SetCornerSize(Value: Integer);
begin
  if FCornerSize <> Value then
    FCornerSize := Value;
  Invalidate;
end;

end.
Original resource: The Delphi Pool
Author: Eddie Shipman
Added: 2009-11-06
Last updated: 2009-11-06

« Return to contents »