请问怎样在Delphi中实现不规则的窗体

procedure TForm1.Button1Click(Sender: TObject);varr:HRGN;beginr:=CreateEllipticRgn(0,0,300,300);SetWindowRgn(handle,r,true);DeleteObject(r);end;椭圆窗体

以下代码供你参考:
四四方方的窗体也会变形，利用win32 API函数setwindowrgn就可以将窗口定义为任何形状，以下是将窗口定义为园角矩形的例子：
procedure TPortForm.FormCreate(Sender: Tobject);
var hr :thandle;
begin
hr:=createroundrectrgn(0,0,width,height,20,20);//定义园角矩形(win API函数)
setwindowrgn(handle,hr,true); //设置园角窗口
end;
为了使该窗口更好，应在onResize事件处理程序放相同的代码。/////////////////////////////////////
用汉字做窗体形状
procedure TForm1.FormCreate(Sender: TObject);
var
rgn:HRGN;
begin
BeginPath(Canvas.Handle);
SetBkMode( Canvas.Handle, TRANSPARENT );
Canvas.Font.Name:= '宋体';
Canvas.Font.Size:=100;
Canvas.TextOut( 20, 20, '漂亮吗?');//用"漂亮吗?"作为form的形状
EndPath(Canvas.Handle);
rgn:= PathToRegion(Canvas.Handle);
SetWindowRgn( Handle, rgn, true );
end;
//不规则窗体移动时如何去掉虚框
0：去掉窗体原来的Caption栏
1：自己做一个模拟的Caption栏。
2：拦截鼠标在这个模拟的区域的Mouse消息，鼠标进入的时候，改变消息所指范围，变成NCHITEST，移出时恢复
3：拦截WM_MOUSEDOWN消息，设置起始点。
4：拦截WM_MOUSEMOVE消息，代码如下：
if ssLeft in Shift then
  begin
   Form1.Left := Form1.Left - (MPos.X-X);
   Form1.Top := Form1.Top - (MPos.Y-Y);
  end;
全部测试代码：
var
MPos:TPoint; {Position of the Form before drag}procedure TForm1.Button1Click(Sender: TObject);
var
  r:HRGN;
begin
  r:=CreateEllipticRgn(0,0,300,300);
  SetWindowRgn(handle,r,true);
  DeleteObject(r);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MPos.X := X;
MPos.Y := Y;
end;procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if ssLeft in Shift then
  begin
   Form1.Left := Form1.Left - (MPos.X-X);
   Form1.Top := Form1.Top - (MPos.Y-Y);
  end;
end;

根据位图做出漂亮的不规则FORM
unit Unit1;  interface  uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons;  type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    function CreateRegion(wMask: TBitmap; wColor: TColor;
      hControl: THandle): HRGN;
    { Private declarations }
  public
    { Public declarations }
  end;  var
  Form1: TForm1;  implementation  {$R *.DFM}  function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
var
  dc, dc_c: HDC;
  rgn: HRGN;
  x, y: integer;
  coord: TPoint;
  line: boolean;
  color: TColor;
begin
  dc := GetWindowDC(hControl);
  dc_c := CreateCompatibleDC(dc);
  SelectObject(dc_c, wMask.Handle);
  BeginPath(dc);
  for x:=0 to wMask.Width-1 do
  begin
    line := false;
    for y:=0 to wMask.Height-1 do
    begin
      color := GetPixel(dc_c, x, y);
      if not (color = wColor) then
      begin
        if not line then
        begin
          line := true;
          coord.x := x;
          coord.y := y;
        end;
      end;
      if (color = wColor) or (y=wMask.Height-1) then
      begin
        if line then
        begin
          line := false;
          MoveToEx(dc, coord.x, coord.y, nil);
          LineTo(dc, coord.x, y);
          LineTo(dc, coord.x + 1, y);
          LineTo(dc, coord.x + 1, coord.y);
          CloseFigure(dc);
        end;
      end;
    end;
  end;
  EndPath(dc);
  rgn := PathToRegion(dc);
  ReleaseDC(hControl, dc);
  Result := rgn;
end;  procedure TForm1.FormCreate(Sender: TObject);
var
  w1:TBitmap;
  w2:TColor;
  rgn: HRGN;
begin
  w1:=TBitmap.Create;
  w1.Assign(image1.Picture.Bitmap);
  w2:=w1.Canvas.Pixels[0,0];
  rgn := CreateRegion(w1,w2,Handle);
  if rgn<>0 then
  begin
     SetWindowRgn(Handle, rgn, true);
  end;
  w1.Free;
end;  procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;  procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Handle, WM_SYSCOMMAND, $F012, 0);
end;  end.

DELPHI中利用API函数实现多态FORM(转帖)陈学军　　实现异型FORM并不是一件难事，本文将向您介绍如何利用API函数实现圆角矩形和椭圆形FORM，并在此基础之上探讨实现TWINcontrol类的后裔的异型的实现。　　欲改变FORM的形状，也就是实现对区域（region）的控制。在Win32 API程序参考手册有关区域（region）的定义是这样描述的：它可以是一个矩形，多边形，椭圆形（或者是两者的复合，或者是更多的形状），这些都可以被填充，画图，翻转，结构化并可以得到焦点执行。　　由定义得出结论：区域（region）是可以被改变和操纵的，依据我们的需求可定义区域并制作出我们所要求的形状。　　应当指出的是区域（region）也能对任何TWINcontrol类的后裔定义和控制（不仅仅是FORMS），就是说，可以将区域（region）的定义运用到向Tpanel或TEdit这样的对象。在改变TWINcontrol类的后裔控件的形状时，需要提供一句柄并创建一些改变形状的函数。　　具体实现方式一般分为两步：　　1．定义所需形状的区域边界形状（比如：椭圆形）。　　2．将已定义的区域边界形状运用到窗口。　　这里，我们将通过调用Windows API函数完成以上两个步骤，下面就具体函数的应用予以说明：　　实现第一步：定义区域边界。　　在这里将调用三个WinAPI，这三个函数是：　　CreateEllipticRgn（）功能是生成椭圆形区域；　　CreateRoundRectRgn（）功能是生成圆角矩形区域；　　CreatePolygonRgn（）功能是生成多边形区域，Windows要确保使其顶点自动相连形成一封闭的区域。　　这三个函数通过返回的指针变量标识所生成的区域将被第二步所应用。这些函数在Delphi中的函数声明及参数含义说明如下：　　（1）椭圆形区域生成函数：　　函数原形：HRGN CreateEllipticRgn(int nLeftRect,int nTopRect,int nRightRect,int nBottomRect); 　　参数含义：　　 nLeftRect，nTopRect：区域的左上角坐标；　　 nRightRect, nBottomRect：区域的右下角坐标；　　（2）圆角矩形区域生成函数：　　函数原形：HRGN CreateRoundRectRgn(int nLeftRect,int nTopRect,int nRightRect,int nBottomRect,int nWidthEllipse,int nHeightEllipse); 　　参数含义：　　 nLeftRect, nTopRect：区域的左上角坐标；　　 nRightRect, nBottomRect：区域的右下角坐标；　　nWidthEllipse, nHeightEllipse：圆角的宽度和高度；　　（3）多边形区域生成函数：　　函数原形：HRGN CreatePolygonRgn(CONST POINT *lppt,int cPoints, int fnPolyFillMode); 　　参数含义：　　 Lppt：指向一个POINT类型的数组，该数组定义多边形顶点；　　 CPoints：定义数组中顶点数；　　 FnPolyFillMode：定义填充模式，可选值为ALTERNATE或WINDING。　　实现第二步：将返回的HRGN类型的区域值被设置窗口区域函数调用。　　设置窗口区域函数：　　函数原形：int SetWindowRgn(HWND hWnd, HRGN hRgn, BOOL bRedraw); 　　参数说明：　　 hWnd：指向所操作的窗口的句柄；　　 hRgn：所给区域句柄；　　 bRedraw：是否显示重画窗口的标志。　　在每一个函数的最后都需要调用SetWindowRgn函数，然后由Windows操作系统实现区域的各种形状的设置并显示。　　以下将测试的FORM的整个源代码列出，在FORM上添加了四个按钮分别控制实现：椭圆形，圆角矩形，等边多边形和星形；一个Tpanel控件为了演示TWINcontrol类的后裔的区域定义和控制；一个SpinEdit控件定义多边形和星形的顶点连接数目。　　源程序: 　　unit form_statue; 　　interface 　　uses 　　 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 　　 StdCtrls, ExtCtrls, Spin; 　　type 　　 TForm1 = class(TForm) 　　　　Button1: TButton; 　　　　SpinEdit1: TSpinEdit; 　　　　Panel1: TPanel; 　　　　Button2: TButton; 　　　　Button3: TButton; 　　　　Button4: TButton; 　　 procedure DrawRndRectRegion(wnd : HWND; rect : TRect); 　　 procedure DrawEllipticRegion(wnd : HWND; rect : TRect); 　　 procedure DrawPolygonRegion(wnd : HWND; rect : TRect; NumPoints : Integer; DoStarShape : Boolean); 　　　　procedure Button1Click(Sender: TObject); 　　　　procedure Button4Click(Sender: TObject); 　　　　procedure Button3Click(Sender: TObject); 　　　　procedure Button2Click(Sender: TObject); 　　 private 　　　　{ Private declarations } 　　　　 rgn : HRGN; 　　　　 rect : TRect; 　　 public 　　　　{ Public declarations } 　　 end; 　　var 　　 Form1: TForm1; 　　implementation 　　{$R *.DFM} 　　 procedure TForm1.DrawRndRectRegion(wnd : HWND; rect : TRect); 　　begin 　　 rgn := CreateRoundRectRgn(rect.left, rect.top, rect.right, rect.bottom, 30, 30); 　　 SetWindowRgn(wnd, rgn, TRUE); 　　end; 　　procedure TForm1.DrawEllipticRegion(wnd : HWND; rect : TRect); 　　begin 　　 rgn := CreateEllipticRgn(rect.left, rect.top, rect.right, rect.bottom); 　　 SetWindowRgn(wnd, rgn, TRUE); 　　end; 　　procedure TForm1.DrawPolygonRegion(wnd : HWND; rect : TRect; NumPoints : Integer; DoStarShape : Boolean); 　　const 　　 RadConvert = PI/180; 　　 Degrees　　= 360; 　　 MaxLines = 100; 　　var 　　 x, y, 　　 xCenter, 　　 yCenter, 　　 radius, 　　 pts, 　　 I　　 : Integer; 　　 angle, 　　 rotation: Extended; 　　 arPts : Array[0..MaxLines] of TPoint; 　　begin 　　 xCenter := (rect.Right - rect.Left) div 2; 　　 yCenter := (rect.Bottom - rect.Top) div 2; 　　 if DoStarShape then 　　　　begin 　　　　 rotation := Degrees/(2*NumPoints); 　　　　 pts := 2 * NumPoints; 　　　　end 　　　　 else 　　　　begin 　　rotation := Degrees/NumPoints;　　　　　　 //得到每个顶点的度数　　 pts := NumPoints ; 　　　　end; 　　 radius := yCenter; 　　 for I := 0 to pts - 1 do begin 　　　　if DoStarShape then 　　　　 if (I mod 2) = 0 then 　　　　　　radius := Round(radius/2) 　　　　 else 　　　　　　radius := yCenter; 　　　　angle := ((I * rotation) + 90) * RadConvert; 　　　　x := xCenter + Round(cos(angle) * radius); 　　　　y := yCenter - Round(sin(angle) * radius); 　　　　arPts[I].X := x; 　　　　arPts[I].Y := y; 　　 end; 　　 rgn := CreatePolygonRgn(arPts, pts, WINDING); 　　 SetWindowRgn(wnd, rgn, TRUE); 　　end; 　　procedure TForm1.Button1Click(Sender: TObject); 　　begin 　　 DrawRndRectRegion(Form1.Handle, Form1.ClientRect); 　　end; 　　procedure TForm1.Button4Click(Sender: TObject); 　　begin 　　 DrawPolygonRegion(Panel1.Handle, Panel1.BoundsRect, SpinEdit1.Value, True); 　　end; 　　procedure TForm1.Button3Click(Sender: TObject); 　　begin 　　 DrawEllipticRegion(Form1.Handle, Form1.ClientRect); 　　end; 　　procedure TForm1.Button2Click(Sender: TObject); 　　begin 　　 DrawPolygonRegion(Panel1.Handle, Panel1.BoundsRect, SpinEdit1.Value, False); 　　end; 　　end. 　　源程序在PWIN98+DELPHI5环境下调试成功，可以直接引用。

调试易

请问怎样在Delphi中实现不规则的窗体

解决方案 »