2006. február 8., szerda

How to change the corner size of RoundRect


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.

Nincsenek megjegyzések:

Megjegyzés küldése