怎样实现不规则窗体和移动

Question

1、怎样实现不规则窗体？
2、按住窗体左键可以移动窗体（因为我的没用标题栏）

Answer 1

1、
var
    pt: array [0..6] of TPoint;
m_rgn: HRGN;
begin
  //================       窗体型状     ============================
pt[0].x:=0;                     pt[0].y:=0;
pt[1].x:=self.Width;           pt[1].y:=0;
pt[2].x:=self.Width;           pt[2].y:=self.Height-20;
pt[3].x:=(self.Width div 2)+20; pt[3].y:=self.Height-20;
  pt[4].x:=self.Width div 2;      pt[4].y:=self.Height;
pt[5].x:=(self.Width div 2)-20; pt[5].y:=self.Height-20;
pt[6].x:=0;                     pt[6].y:=self.Height-20;
  m_rgn:=CreatePolygonRgn(pt,7,WINDING);
SetWindowRgn(self.Handle,m_rgn,TRUE);
  //==================================================================end;2、
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(self.Handle, WM_SYSCOMMAND,SC_MOVE+HTCAPTION, 0);
end;

Answer 2

Delphi中的窗体移动
Night @ 2004-07-25 23:02　　如果你在开发图形或多媒体应用程序,你可能正在为如何不使用窗体的标题栏而移动窗体发愁。其实只需用鼠标拖动窗体的客户区就可以了。 
            方法一 
　　 
　　以下是完成上述功能最普通的方法:在窗体的private声明部分加入以下过程声明:procedure WMNCHitTest(var Msg:TWMNCHitTest);message WM_NCHITTEST;然后在implementation部分加入以下代码: 
           procedure TForm1{或你定义的Form名}.WMNCHitTest(var Msg:TWMNCHitTest); 
           begin 
           DefaultHandler(Msg); 
           if Msg.Result = HTCLIENT then 
           Msg.Result:= HTCAPTION; 
           end; 
此方法中使当鼠标点击窗体客户区时,令Windows认为被点击的是标题栏。 
           
方法二 
　　  　　 
　　以下是另一个实现用鼠标移动普通窗体的方法。 
           procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; 
           X, Y: Integer); 
           begin 
           if (ssLeft in Shift) then begin 
           ReleaseCapture; 
           SendMessage(Form1.Handle,WM_SYSCOMMAND,SC_MOVE+1,0); 
           end; 
           end; 　　以上方法不完善之处 　　当把“拖动窗口的过程中显示其内容”的选项取消时,让我们看看会发生什么。这是Windows窗口的一项设置,你可以在“开始菜单-->设置-->文件夹选项-->查看-->高级设置”中找到该属性。在Windows95中,你需要修改注册表。当此属性被设为无效,拖动窗体时窗体会变为一个正方形轮廓线。也许你使用一个不规则窗体,但它仍然会显示轮廓线。 
　　 
　　当你想要让你的窗体停靠在屏幕的边缘(如:WinAmp,当你拖动窗体进入屏幕顶部某一特定位置时,窗体便紧靠在屏幕顶部),如果你使用以上第二种方法,在鼠标按钮放开前,你将无法处理窗体位置,并无法处理停靠问题。 　　下面我会用简单的方法解决两个问题: 
　　 
　　第一,无论设置为何,在拖动窗体时都不显示轮廓线; 
　　 
　　第二,移动窗体时进行位置检测,并在位置适当时停靠在某一特定位置。很多人也许已经解决了这些问题,但是也许下面的代码对你会有帮助。 方法三 　　以下代码可以直接复制到Delphi中,前提是你将Form1存为uMain.pas,Form2存为uDock.pas。用到的事件是:onMouseDown,onMouseMove,onMouseUp,OnShow(Form1)。 
　　 
　　这是一个根据鼠标的移动移动窗体的方法,包含两个窗体,uMain和uDock(Form1和Form2)。Form2通过Form1打开,并可以停靠在Form1的底部。停靠后,Form2将随Form1一起移动,直到你将Form2移开。 
　　Form1 
           unit uMain; 
           interface 
           uses 
           Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
           Dialogs; 
           type 
           TForm1 = class(TForm) 
           procedure FormMouseDown(Sender:TObject; 
           Button:TMouseButton;Shift:TShiftState;X,Y: Integer); 
           procedure FormMouseMove(Sender: TObject; Shift: TShiftState;X,Y: 
           Integer); 
           procedure 
           FormMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y: 
           Integer); 
           procedure FormShow(Sender: TObject); 
           private 
           { Private declarations } 
           public 
           DocktoForm: Boolean; 
           { Public declarations } 
           end; 
           var 
           Form1: TForm1; 
           CanMove, CanMoveX, CanMoveY: Boolean; 
           OldX, OldY: Integer; 
           F1X,F1Y,F2X,F2Y: integer; 
           WorkArea : TRect; 
           implementation 
           uses uDock; 
           {$R *.DFM} 
           procedure TForm1.FormMouseDown(Sender: TObject; Button: 
           TMouseButton;Shift: TShiftState; X, Y: Integer); 
           begin 
           CanMoveX := true; 
           CanMoveY := true; 
           CanMove := true; 
           OldX := X; 
           OldY := Y; 
           if DocktoForm then 
     begin 
           F1X := Form1.Left; 
           F1Y := Form1.Top; 
           F2X := Form2.Left; 
           F2Y := Form2.Top; 
           end; 
           end; 
           procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; 
           X, Y: Integer); 
           begin 
           if (CanMove) then 
           begin 
           if CanMoveX then 
           Form1.Left := Form1.Left + (X - OldX); 
           if CanMoveY then 
           Form1.Top := Form1.Top + (Y - OldY); 
           //This section latches to the top 
           if (Form1.Top < WorkArea.Top + 10) and (Form1.Top > WorkArea.Top-10) 
           then 
           begin 
           Form1.Top := WorkArea.Top; 
           if (Y-OldY > 10) or (Y-OldY < -10) then 
           CanMoveY := true 
           else 
           CanMoveY := False; 
           end; 
           //This section latches to the left side 
           if (Form1.Left < WorkArea.Left+10) and (Form1.Left > 
           WoskArea.Left-10) then 
           begin 
           Form1.Left := WorkArea.Left; 
           if (X-OldX > 10) or (X-OldX < -10) then 
           CanMoveX := true 
           else 
           CanMoveX := False; 
           end; 

Answer 3

//This section latches to the right side 
           if (Form1.Left > WorkArea.Right-Form1.Width-10) and (Form1.Left < 
           WorkArea.Right-Form1.Width+10) then 
           begin 
           Form1.Left := WorkArea.Right-Form1.Width; 
           if (X-OldX > 10) or (X-OldX < -10) then 
           CanMoveX := true 
           else 
           CanMoveX := False; 
           end; 
           //This section latches to the TaskBar 
           if DocktoForm then 
           begin 
           if (Form1.Top > WorkArea.Bottom-Form1.Height-Form2.Height-10) and 
           (Form1.Top < WorkArea.Bottom-Form1.Height-Form2.Height+10) then 
           begin 
           Form1.Top := WorkArea.Bottom-Form1.Height-Form2.Height; 
           if (Y-OldY > 10) or (Y-OldY < -10) then 
           CanMoveY := true 
           else 
           CanMoveY := False; 
           end; 
           end 
           else begin 
           if (Form1.Top > WorkArea.Bottom-Form1.Height-10) and (Form1.Top < 
           WorkArea.Bottom-Form1.Height+10) then 
           begin 
           Form1.Top := WorkArea.Bottom-Form1.Height; 
           if (Y-OldY > 10) or (Y-OldY < -10) then 
           CanMoveY := true 
           else 
           CanMoveY := False; 
           end; 
           end; 
     if DocktoForm then 
           begin 
           Form2.Left := Form1.Left - (F1X-F2X);// + (X-OldX); 
           Form2.Top := Form1.Top+Form1.Height; 
           exit; 
           end; 
           //This section latches playlist in center of Form1 
           if (Form2.Left > Form1.Left + ((Form1.Width div 2)-(Form2.Width div 
           2))-10) and (Form2.Left < Form1.Left + ((Form1.Width div 
           2)-(Form2.Width div 2))+10) and 
           (Form2.Top > Form1.Top+Form1.Height-10) and (Form2.Top < 
           Form1.Top+Form1.Height+10) then 
           begin 
           Form2.Left := Form1.Left + ((Form1.Width div 2)-(Form2.Width div 2)); 
           DocktoForm := True; 
           F1X := Form1.Left; 
           F1Y := Form1.Top; 
           F2X := Form2.Left; 
           F2Y := Form2.Top; 
           end; 
           end; 
           end; 
           procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
           Shift: TShiftState; X, Y: Integer); 
           begin 
           CanMove := false; 
           end; 
           procedure TForm1.FormShow(Sender: TObject); 
           begin 
           //Get Work Area Parameters 
           SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0 ); 
           Form2.Show; 
           end; 
           end. 
   Form2 
           unit uDock; 
           interface 
           uses 
           Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
           Dialogs; 
           type 
           TForm2 = class(TForm) 
           procedure FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: 
           TShiftState; X, Y: Integer); 
           procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: 
           Integer); 
           procedure FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: 
           TShiftState; X, Y: Integer); 
           private 
           { Private declarations } 
           public 
           { Public declarations } 
           end; 
           var 
           Form2: TForm2; 
           CanMove, CanMoveX, CanMoveY, DocktoForm: Boolean; 
           OldX, OldY: Integer; 
           implementation 
           uses uMain; 
           {$R *.DFM} 
           procedure TForm2.FormMouseDown(Sender: TObject; Button: 
           TMouseButton;Shift: TShiftState; X, Y: Integer); 
           begin 
           CanMoveX := true; 
           CanMoveY := true; 
           CanMove := true; 
           OldX := X; 
           OldY := Y; 
           end; 
           procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; 
           X, Y: Integer); 
           begin 
           if (CanMove) then 
           begin 
           if CanMoveX then 
           Form2.Left := Form2.Left + (X - OldX); 
           if CanMoveY then 
           Form2.Top := Form2.Top + (Y - OldY); 
           //This section latches to the top 
           if (Form2.Top < WorkArea.Top + 10) and (Form2.Top > WorkArea.Top-10) 
           then 
  begin 
           Form2.Top := WorkArea.Top; 
           if (Y-OldY > 10) or (Y-OldY < -10) then 
           CanMoveY := true 
           else 
           CanMoveY := False; 
           end; 
           //This section latches to the left side 
           if (Form2.Left < WorkArea.Left+10) and (Form2.Left > 
           WorkArea.Left-10) then 
           begin 
           Form2.Left := WorkArea.Left; 
           if (X-OldX > 10) or (X-OldX < -10) then 
           CanMoveX := true 
           else 
           CanMoveX := False; 
           end; 
           //This section latches to the right side 
           if (Form2.Left > WorkArea.Right-Form2.Width-10) and (Form2.Left < 
           WorkArea.Right-Form2.Width+10) then 
           begin 
           Form2.Left := WorkArea.Right-Form2.Width; 
           if (X-OldX > 10) or (X-OldX < -10) then 
           CanMoveX := true 
           else 
           CanMoveX := False; 
           end; 
           //This section latches to the TaskBar 
           if (Form2.Top > WorkArea.Bottom-Form2.Height-10) and (Form2.Top < 
           WorkArea.Bottom-Form2.Height+10) then 
           begin 
           Form2.Top := WorkArea.Bottom-Form2.Height; 
           if (Y-OldY > 10) or (Y-OldY < -10) then 
           CanMoveY := true 
           else 
           CanMoveY := False; 
           exit; 
           end; 
 //This section latches to the Player Bottom 
           if (Form2.Top > Form1.Top+Form1.Height-10) and (Form2.Top < 
           Form1.Top+Form1.Height+10) and (Form2.Left > Form1.Left-Form2.Width) 
           and (Form2.Left < Form1.Left + Form1.Width) then 
           begin 
           Form2.Top := Form1.Top+Form1.Height; 
           if (Y-OldY > 10) or (Y-OldY < -10) then begin 
           CanMoveY := true; 
           Form1.DockToForm := False; 
           end 
           else begin 
           CanMoveY := False; 
           Form1.DockToForm := True; 
           end; 
           end; 
           //This section latches playlist in center of Form1 
           if (Form2.Left > Form1.Left + ((Form1.Width div 2)-(Form2.Width div 
           2))-10) and (Form2.Left < Form1.Left + ((Form1.Width div 
           2)-(Form2.Width div 2))+10) and 
           (Form2.Top > Form1.Top+Form1.Height-10) and (Form2.Top < 
           Form1.Top+Form1.Height+10) then 
           begin 
           Form2.Left := Form1.Left + ((Form1.Width div 2)-(Form2.Width div 2)); 
           if (X-OldX > 10) or (X-OldX < -10) or (Y-OldY > 10) or (Y-OldY < 
           -10) then 
           CanMoveX := true 
           else 
           CanMoveX := False; 
           end; 
           end; 
           end; 
           procedure TForm2.FormMouseUp(Sender: TObject; Button: 
           TMouseButton;Shift: TShiftState; X, Y: Integer); 
           begin 
           CanMove := false; 
           end; 
           end. 　　我希望以上内容对那些正面临类似内容困扰的人有所帮助。 

Answer 4

//创建不规则窗体----三角形窗体：unit rgncode;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormResize( Sender: TObject );
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  procedure SetTriangleWin( w: HWND );implementation
{$R *.DFM}
procedure SetTriangleWin( w: HWND );
var
  rgn: HRGN;
  points: array [ 0..2 ] of TPoint;
  wrect: TRect;
begin
  if (SetWindowRgn(w,0,false)=0 ) then
  begin
    ShowMessage( '不能设置窗口形状！' );
    exit;
  end;
  if not (GetWindowRect(w, wrect)) then
  begin
    ShowMessage( '无法得到窗口区域！' );
    exit;
  end;
  // 利用point数组建立新的窗体形状
  points[ 0 ].x := 0;
  points[ 0 ].y :=0;
  points[ 1 ].x := ( wrect.right - wrect.left ) div 2;
  points[ 1 ].y := wrect.bottom - wrect.top;
  points[ 2 ].x := wrect.right - wrect.left;
  points[ 2 ].y :=0;
  // 创建该窗体
  rgn := CreatePolygonRgn( points, 3, WINDING );
  if ( rgn = 0 ) then
    ShowMessage( '无法创建不规则窗体！' )
  else
  begin
    if (SetWindowRgn(w,rgn,true)=0) then
    begin
      ShowMessage( '无法创建不规则窗体！' );
    end;
  end;
end;procedure TForm1.FormResize(Sender: TObject);
begin
  // 重新设置窗体区域
  Label1.Left := ( ClientWidth - Label1.Width ) div 2;
  Label1.Top := ( ClientHeight - Label1.Height ) div 2;
  SetTriangleWin( Handle );
  Invalidate;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //关闭前清除自定义窗体
  SetWindowRgn( Handle, 0, false );
end;procedure TForm1.FormShow(Sender: TObject);
begin
  SetTriangleWin( Handle );
end;end.
//随意拖动的窗体
type
  TForm1 = class(TForm)
  procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
......
implementation
procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited; { 调用默认的事件处理程序 }
if M.Result = htClient then M.Result := htCaption;
{如果是在Client区让Windows认为是在Caption区 }
end;{$R *.dfm}
......

Answer 5

在private部分加入下列代码：
procedure wmnchittest(var msg:twmnchittest);
message wm_nchittest;
在程序部分加入以下代码：
procedure TForm1.wmnchittest(var msg:twmnchittest);
begin
inherited;
if (htclient=msg.result) then msg.result:=htcaption;
end;
　　上面的关键代码虽然只有两行，但它实现了鼠标直接拖动窗体的目的。代码的原理是利用窗体的WM_NCHITTEST消息，这个消息是当光标移动、鼠标按下或释放时发生的，当程序检测到鼠标在窗体中按下的消息后（消息的值为htClient），将鼠标在标题栏上按下时产生的消息（值为htCaption）传递出去，这样就巧妙的欺骗程序认为是标题栏被按下，当然就可拖动窗体了。

Answer 6

事实上在Delphi7中用以下几步可以简单实现不规则的窗体:1. 建立工程后,设定 Form1的属性
  BorderStyle = bsNone
  TransparentColor = True
  TransparentColorValue = clWhite  //将会透明的颜色,在此设为白色
2.放个Image1在Form上,
  Image1.Align = alClient
3.导入一张图片入Image1这样,运行后,Image1上白色的部分都会不见.至于移动,仍然像SuanAddMiao(算苗) 说的

Answer 7

Delphi6也可以用上面的简单实现不规则的窗体:建立工程后,设定 Form1的属性
  BorderStyle = bsNone
  TransparentColor = True
  TransparentColorValue = clWhite  //将会透明的颜色,在此设为白色
其它都是相同的.