请问如何实现圆角的TPanel? ( 积分: 300 )

  • 主题发起人 主题发起人 ccw128
  • 开始时间 开始时间
C

ccw128

Unregistered / Unconfirmed
GUEST, unregistred user!
请问如何实现四个角都是圆角(而不是直角)的TPanel?如下图所示:

http://ihome.cuhk.edu.hk/~s040991/frame.jpg
 
请问如何实现四个角都是圆角(而不是直角)的TPanel?如下图所示:

http://ihome.cuhk.edu.hk/~s040991/frame.jpg
 
hr:=createroundrectrgn(0,0,width,height,20,20);//定义园角矩形(win API函数)

setwindowrgn(handle,hr,true); //设置园角窗口

另外加自画就行了。
 
能否具体一点,TPanel好像不支持OwnerDraw
 
xpwindow有,不仅圆角还能伸缩
 
自己写一个控件得了(从Panel继承),将以下代码保存为pas文件,
再安装到Delphi中即可使用,并且我还将Paint事件放出来了:

unit OwnerDrawPanel;

interface

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

const
DEFAULT_ROUND = 16;

type
TOwnerDrawPanel = class(TPanel)
private
{ Private declarations }
FOwnerDraw: Boolean;
FRoundX: Integer;
FRoundY: Integer;
FOnPaint: TNotifyEvent;
procedure SetOwnerDraw(Value: Boolean);
procedure SetRoundX(Value: Integer);
procedure SetRoundY(Value: Integer);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
property Canvas;
procedure Paint; override;
published
{ Published declarations }
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default True;
property RoundX: Integer read FRoundX write SetRoundX default DEFAULT_ROUND;
property RoundY: Integer read FRoundY write SetRoundY default DEFAULT_ROUND;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Standard', [TOwnerDrawPanel]);
end;

constructor TOwnerDrawPanel.Create(AOwner: TComponent);
begin
inherited;
Height := 160;
FOwnerDraw := True;
FRoundX := DEFAULT_ROUND;
FRoundY := DEFAULT_ROUND;
end;

procedure TOwnerDrawPanel.SetOwnerDraw(Value: Boolean);
begin
if FOwnerDraw <> Value then
begin
FOwnerDraw := Value;
Paint;
end;
end;

procedure TOwnerDrawPanel.SetRoundX(Value: Integer);
begin
if FRoundX <> Value then
begin
FRoundX := Value;
Paint;
end;
end;

procedure TOwnerDrawPanel.SetRoundY(Value: Integer);
begin
if FRoundY <> Value then
begin
FRoundY := Value;
Paint;
end;
end;

procedure TOwnerDrawPanel.Paint;

procedure DrawOwner;
begin
with Canvas do
begin
Brush.Color := clBtnFace;
FillRect(ClientRect);
Brush.Color := clWindow;
RoundRect(ClientRect.Left, ClientRect.Top, ClientRect.Right,
ClientRect.Bottom, FRoundX, FRoundY);
end;
end;

begin
if FOwnerDraw then
DrawOwner
else
inherited;
if Assigned(FOnPaint) then
FOnPaint(Self);
end;

end.
 
ExtraPack控件包中有两个TepRndPanel,TepEffectRndPanel都是继承Tpanel类的。
自己去看源码吧。
 
给个例子 按自己要求改一改就OK了

procedure TForm1.FormCreate(Sender: TObject);
const
bgcolor = $00FFDDEE;
linecolor = $00554366;
var
img: array of TImage;
reg: hrgn;
i: Integer;
begin
for i := 0 to ComponentCount - 1 do
begin
if Components.ClassName = 'TPanel' then
begin
setlength(img, Length(img) + 1);
img := TImage.Create(Self);
img.Width := (Components as TPanel).Width;
img.Height := (Components as TPanel).Height;
img.Parent := (Components as TPanel);
img.Canvas.Brush.Color := bgcolor;
img.Canvas.pen.Color := bgcolor;
img.Canvas.Rectangle(0,0,img.Width, img.Height);
img.Canvas.pen.Color := linecolor;
img.Canvas.RoundRect(0,0,img.Width - 1,img.Height - 1,20,20);
reg := CreateRoundRectRgn(0,0,(Components as TPanel).Width,
(Components as TPanel).Height, 20,20);
setwindowrgn((Components as TPanel).Handle, reg, True);
deleteobject(reg);
end;
end;
end;
 
看看这个资料合不合你用吧
procedure MakeRounded(Control: TWinControl);
var
R: TRect;
Rgn: HRGN;
begin
with Control do
begin
R := ClientRect;
rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20);
Perform(EM_GETRECT, 0, lParam(@r));
InflateRect(r, - 5, - 5);
Perform(EM_SETRECTNP, 0, lParam(@r));
SetWindowRgn(Handle, rgn, True);
Invalidate;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
// TMemo:
Memo1.BorderStyle := bsNone;
MakeRounded(Memo1);
// TEdit:
Edit2.BorderStyle := bsNone;
MakeRounded(Edit2);
// TPanel:
MakeRounded(Panel1);
end;
 
dreamisx大哥,能不能在你给出的代码上再加右边和底部阴影呀(阴影大小可以随意用数字改大小)
 
后退
顶部