How to change the corner size of RoundRect (Views: 1217)
Problem/Question/Abstract: 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? Answer: 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 { Private declarations } FCornerSize: Integer; procedure SetCornerSize(Value: Integer); protected { Protected declarations } procedure Paint; override; public { Public declarations } constructor Create(AOwner: TComponent); override; published { Published declarations } 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. |