如何改变按钮的形状？请指教！！！！

Question

在DELPHI里的按钮都是矩形的，若是要是改变形状，比如该成圆形，可以怎么实现？
具体步骤是怎样？
请各位指教一下！谢谢！

Answer 1

procedure MakeRounded(Control: TWinControl;m,n:integer);
var
  R: TRect;
  Rgn: HRGN;
begin
  with Control do
  begin
    R := ClientRect;
    rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom,m, n);
    Perform(EM_GETRECT, 0, lParam(@r));
    InflateRect(r, - 5, - 5);
    Perform(EM_SETRECTNP, 0, lParam(@r));
    SetWindowRgn(Handle, rgn, True);
    Invalidate;
  end;
end;给wincontrol继承下来的控件画，m，n是角弧度

Answer 2

那你就从TGraphicControl继承下来，自己画啊
例子，保存为pas文件，安装一下看看效果unit RVButton;interface uses
  Forms,SysUtils, Classes, Controls, Messages, Graphics, Windows;const 
  iOffset = 3; type 
  TRVButton = class(TGraphicControl)
  private 
    FCaption : string; 
    FButtonColor: TColor;
    FMouseEnterColor:TColor;
    FMouseleaveColor:Tcolor;
    FLButtonDown: boolean; 
    FBtnPoints : array[1..2] of TPoint; 
    FKRgn : HRgn; 
    procedure SetCaption(Value: string); 
    procedure SetButtonColor(Value: TColor);
    procedure SetMouseEnterColor(Value: TColor);
 //   procedure SetMouseLeaveColor(Value: TColor);
    procedure FreeRegion; 
  protected 
    procedure Paint; override;
    procedure DrawCircle;
    procedure MoveButton; 
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; 
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ButtonColor: TColor read FButtonColor write SetButtonColor;
    property MouseEnterColor: TColor read FMouseEnterColor write SetMouseEnterColor;
 //   property MouseLeaveColor: TColor read FMouseLeaveColor write SetMouseLeaveColor;
    property Caption: string read FCaption write SetCaption;
    property Enabled;
    property Font; 
    property ParentFont; 
    property ParentShowHint; 
    property ShowHint; 
    property Visible; 
    property OnClick; 
  end; procedure Register; implementationprocedure Register; 
begin 
  RegisterComponents('Samples', [TRVButton]); 
end; { TRVButton } constructor TRVButton.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  ControlStyle := [csClickEvents,csCaptureMouse]; 
  Width := 50; 
  Height := 50; 
  FButtonColor := clBtnFace;
  FMouseEnterColor:=clBtnFace;
  FMouseLeaveColor:=clBtnFace;
  FKRgn := 0;
  FLButtonDown := False;
end; destructor TRVButton.Destroy; 
begin 
  if FKRgn <> 0 then FreeRegion; 
  inherited Destroy; 
end; procedure TRVButton.DrawCircle; 
begin 
  FBtnPoints[1] := Point(iOffset,iOffset); 
  FBtnPoints[2] := Point(Width - iOffset,Height - iOffset); 
  FKRgn := CreateEllipticRgn(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y); 
  Canvas.Brush.Color := FButtonColor;
  FillRgn(Canvas.Handle,FKRgn,Canvas.Brush.Handle); 
  MoveButton; 
end; procedure TRVButton.FreeRegion; 
begin 
  if FKRgn <> 0 then DeleteObject(FKRgn); 
  FKRgn := 0; 
end; procedure TRVButton.MoveButton; 
var 
  Color1: TColor; 
  Color2: TColor; 
begin 
  with Canvas do 
    begin 
    if not FLButtonDown then 
      begin 
      Color1 := clBtnHighlight; 
      Color2 := clBtnShadow; 
      end 
    else 
      begin 
      Color1 := clBtnShadow; 
      Color2 := clBtnHighLight; 
      end;       Pen.Width := 1;       if FLButtonDown then Pen.Color := clBlack 
      else                 Pen.Color := Color2;       Ellipse(FBtnPoints[1].x - 2,FBtnPoints[1].y - 2,FBtnPoints[2].x + 2,FBtnPoints[2].y + 2);       if not FLButtonDown then Pen.Width := 2 
      else                     Pen.Width := 1;       Pen.Color := Color1;       Arc(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y, 
          FBtnPoints[2].x,FBtnPoints[1].y,FBtnPoints[1].x,FBtnPoints[2].y);       Pen.Color := Color2;       Arc(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y, 
          FBtnPoints[1].x,FBtnPoints[2].y,FBtnPoints[2].x,FBtnPoints[1].y); 
      end;   SetCaption(''); 
end; procedure TRVButton.Paint; 
begin 
  inherited Paint; 
  FreeRegion; 
  DrawCircle; 
end; procedure TRVButton.SetButtonColor(Value: TColor); 
begin 
  if Value <> FButtonColor then 
    begin 
    FButtonColor := Value;
    Invalidate;
    end; 
end;
procedure TRVButton.SetMouseEnterColor(Value: TColor);
begin 
  if Value <> FButtonColor then 
    begin
    FMouseEnterColor := Value;
    Invalidate; 
    end; 
end;
{procedure TRVButton.SetMouseLeaveColor(Value: TColor);
begin
  if Value <> FMouseEnterColor then
    begin
    FMouseLeaveColor := Value;
    Invalidate; 
    end; 
end; }
procedure TRVButton.SetCaption(Value: string);
var 
  X: Integer; 
  Y: Integer; 
begin 
  if ((Value <> FCaption) and (Value <> '')) then 
  begin 
    FCaption := Value; 
  end;   with Canvas.Font do 
  begin 
    Name  := Font.Name; 
    Size  := Font.Size; 
    Style := Font.Style; 
    if Self.Enabled then Color := Font.Color 
    else 
      Color := clDkGray; 
  end;   X := (Width div 2) - (Canvas.TextWidth(FCaption) div 2); 
  Y := (Height div 2) - (Canvas.TextHeight(FCaption) div 2); 
  Canvas.TextOut(X, Y, FCaption); 
  //  Invalidate; 
end; 
procedure TRVButton.WMLButtonDown(var Message: TWMLButtonDown); 
begin 
  if not PtInRegion(FKRgn,Message.xPos,Message.yPos) then exit; 
  FLButtonDown := True; 
  MoveButton; 
  inherited; 
end; procedure TRVButton.WMLButtonUp(var Message: TWMLButtonUp);
begin 
  if not FLButtonDown then exit; 
  FLButtonDown := False;
  MoveButton;
  inherited;end; 
procedure TRVButton.CMMouseEnter(var Msg: TMessage);
begin
  if self.Enabled then begin
  FMouseLeaveColor:=FButtonColor;
  FButtonColor:=FMouseEnterColor;
  Invalidate;
  inherited ;
  end;
end;
procedure TRVButton.CMMouseLeave(var Msg: TMessage);
begin
if self.Enabled then begin
 FButtonColor:=FMouseLeaveColor;
 Invalidate;
 inherited ;
 end;
end;end.