真正的不规则窗体来了，大家看看我的代码哦，不灵别给分 在你的窗体上放一个PICTUREBOX控件，再放一个COMMDIALOG控件，将窗体和PICTUREBOX的SCALEMODE属性设为PIXEL，然后将下面的代码贴进去就可以了 Option ExplicitPrivate Type Position X As Long Y As Long End TypeDim MoveFrom As Position Dim Dot(100000) As Position Dim OldWindow(3) As Position 'Put the original size of form Dim DotNumber As Long 'The number of Dots in the Poly line Dim DXY(7) As Position 'The offset x,y if each deriction Dim Direction As Long Dim BKCOLOR As Long 'The BASE-Color, it must be defferent to the color of the edge Const GrayDeff As Long = 150 'The defference of Color-Gray between the BASE-Color and the EDGE-Color Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal HRgn As Long, ByVal bRedraw As Boolean) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Sub Command1_Click() End SubPrivate Sub Form_Load() BKCOLOR = Me.BackColor DXY(0).X = 0 DXY(0).Y = -1 DXY(1).X = 1 DXY(1).Y = -1 DXY(2).X = 1 DXY(2).Y = 0 DXY(3).X = 1 DXY(3).Y = 1 DXY(4).X = 0 DXY(4).Y = 1 DXY(5).X = -1 DXY(5).Y = 1 DXY(6).X = -1 DXY(6).Y = 0 DXY(7).X = -1 DXY(7).Y = -1 With Me OldWindow(0).X = .ScaleLeft OldWindow(0).Y = .ScaleTop OldWindow(1).X = .ScaleLeft + .ScaleWidth OldWindow(1).Y = .ScaleTop OldWindow(2).X = .ScaleLeft + .ScaleWidth OldWindow(2).Y = .ScaleTop + .ScaleHeight OldWindow(3).X = .ScaleLeft OldWindow(3).Y = .ScaleTop + .ScaleHeight End With End SubPrivate Function FirstDot(ByVal X As Long, ByVal Y As Long) As Boolean Dim X1 As Long Dim Y1 As Long Dim Wid As Long Dim Hei As Long Dim Col As Long On Error Resume Next With Picture1 BKCOLOR = .Point(X, Y) Wid = .Width - 1 Hei = .Height - 1 For X1 = X To Wid '扫描第一个点的位置，注意：这里是先从上到下，再从左到右，所以开始Direction的初始值是4 For Y1 = Y To Hei Col = .Point(X1, Y1) If GetDeff(Col, BKCOLOR) > GrayDeff Then Dot(0).X = X1 '第一个点的DotNumber总是0 Dot(0).Y = Y1 '所以直接写0而不写DotNumber了 GoTo Find Else BKCOLOR = Col End If Next Next Find: DotNumber = 1 Direction = 4 End With End FunctionPrivate Sub SeekEdge() Dim DX As Long Dim DY As Long Dim I As Long Dim L As Long Dim LastDirection As Long Dim Col As Long LastDirection = 0 L = 0 Do Direction = (Direction + 4) Mod 8 '在开始下以点的查找前，必须先把探测方向转180度 For I = 0 To 7 Direction = (Direction + 1) Mod 8 Dot(DotNumber).X = Dot(L).X + DXY(Direction).X Dot(DotNumber).Y = Dot(L).Y + DXY(Direction).Y If GetDeff(Picture1.Point(Dot(DotNumber).X, Dot(DotNumber).Y), BKCOLOR) > GrayDeff Then Exit For Next If Direction <> LastDirection Then '同方向点判断和压缩 L = DotNumber DotNumber = L + 1 LastDirection = Direction Else Dot(L).X = Dot(DotNumber).X Dot(L).Y = Dot(DotNumber).Y 'DotNumber = L End If Loop Until Dot(DotNumber).X = Dot(0).X And Dot(DotNumber).Y = Dot(0).Y Or DotNumber > 99999 End SubPrivate Sub PolyWindow(ByVal Restore As Boolean) Dim HRgn As Long 'HWND of Region If Restore Then HRgn = CreatePolygonRgn(OldWindow(0), 4, 1) Picture1.Cls Else HRgn = CreatePolygonRgn(Dot(0), DotNumber, 1) MsgBox "Dot Number:" & DotNumber End If SetWindowRgn Me.hWnd, HRgn, True DeleteObject HRgn End SubPrivate Sub PolyLine() Dim I As Long Picture1.DrawMode = 7 Picture1.DrawWidth = 1 Picture1.AutoRedraw = True For I = 1 To DotNumber Picture1.Line (Dot(I - 1).X, Dot(I - 1).Y)-(Dot(I).X, Dot(I).Y) Next Picture1.DrawMode = 13 Picture1.DrawWidth = 2 Picture1.Refresh End SubPrivate Function GetDeff(ByVal Col As Long, ByVal BKCol As Long) As Long GetDeff = Abs((Col Mod 256) - (BKCol Mod 256)) GetDeff = GetDeff + Abs((Col \ 256 Mod 256) - (BKCol \ 256 Mod 256)) GetDeff = GetDeff + Abs((Col \ 65536) - (BKCol \ 65536)) End FunctionPrivate Sub Picture1_DblClick() FirstDot MoveFrom.X, MoveFrom.Y SeekEdge 'PolyLine PolyWindow DotNumber < 3 End SubPrivate Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer) Dim A As String If KeyCode = 13 Then CommonDialog1.ShowOpen A = CommonDialog1.FileName If Trim(A) <> "" Then Picture1.Picture = LoadPicture(A) With Me .Width = Picture1.Width / 1024 * 1440 * 12 '* 0.715 .Height = Picture1.Height / 768 * 1440 * 9 '* 0.715 OldWindow(0).X = .ScaleLeft OldWindow(0).Y = .ScaleTop OldWindow(1).X = .ScaleLeft + .ScaleWidth OldWindow(1).Y = .ScaleTop OldWindow(2).X = .ScaleLeft + .ScaleWidth OldWindow(2).Y = .ScaleTop + .ScaleHeight OldWindow(3).X = .ScaleLeft OldWindow(3).Y = .ScaleTop + .ScaleHeight End With End If End If PolyWindow True End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) MoveFrom.X = X MoveFrom.Y = Y End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim Col As Long Col = Picture1.Point(X, Y) Picture1.ToolTipText = X & ":" & Y & " >>" & GetDeff(Col, 0) End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim MoveTo As Position If Button = 1 Then With Me MoveTo.X = .Left + (X - MoveFrom.X) / 1024 * 1440 * 12 * 0.715 '15寸显示器宽为12寸，因为实际尺寸不到15寸所以要比实际少点 MoveTo.Y = .Top + (Y - MoveFrom.Y) / 768 * 1440 * 9 * 0.715 '15寸显示器宽为9寸 .Move MoveTo.X, MoveTo.Y 'MsgBox .Left & " " & .Top End With End If If Button = 2 Then Picture1.Line (MoveFrom.X, MoveFrom.Y)-(X, Y) End If End Sub'说明一下，这个程序有几个地方我偷懒了，一是移动无界面窗体的办法，因为我懒得查API就自己写了个土办法，可能显示器不是15寸的朋友在移动的时候会有点偏差。二是PictureBox控件中加载的图片不要太花哨，对比度要大一些，否则可能会裁下来很小很小的一个窗体，甚至小到你这个窗体只有1个像素，到时候找不到你的窗体可别怪我哦。对啦，差点忘了，鼠标双击图片的不同部位可以得到不同的裁剪效果。对着图片按着鼠标右键拖放，可以画一条直线，对着图片按键盘可以加载其他图片。 这个程序我使用了行程压缩的方法，所以比一般算法得到的不规则窗体的关键点少很多，可以加快执行的速度，但是因为我使用的边界探测算法不好，所以有的时候会因为找不到边界点造成死循环(建议大家用卡通画之类边界明显的图片来试会得到非常好的效果)，这不，我这里已经死循环了，要是有哪位高手可以给个好点的边界探测的算法，将不胜感激！对了，贴在这里或发信息给我都行！
你是不是想做一个空心的按钮或者不规则形状控件之类？？？？网上很多例子。
我想做一个曲线控件 回复人： kmzs(.:RNPA:.山水岿濛) ( ) 信誉：105 2004-07-11 20:22:00 得分: 0
曾经见过椭圆按钮空间，不知道是不是VB做得
===================================================
相对来说，“椭圆 ”其实也是有规则的，所以实现起来并不难方法可参考：
http://vbworld.sxnw.gov.cn/articles/api/tvb54.html。
文章里介绍的是怎么做一些特殊形状的窗体，如果想做特殊形状的控件，只要把窗体的句柄改为控件的句柄就基本可以了。
而更进一步的，是实现真正的完全不规则窗体，代码可参考：
http://www.moon-soft.com/download/other/j011.zip
而再更进一步的，是在2000、xp下制作半透明的异形窗体。代码上google找找吧应该有的
===============================================WS_EX_LAYERED 不能被用在子窗口上。
http://www.moon-soft.com/download/other/j011.zip
在你的窗体上放一个PICTUREBOX控件，再放一个COMMDIALOG控件，将窗体和PICTUREBOX的SCALEMODE属性设为PIXEL，然后将下面的代码贴进去就可以了
Option ExplicitPrivate Type Position
X As Long
Y As Long
End TypeDim MoveFrom As Position
Dim Dot(100000) As Position
Dim OldWindow(3) As Position 'Put the original size of form
Dim DotNumber As Long 'The number of Dots in the Poly line
Dim DXY(7) As Position 'The offset x,y if each deriction
Dim Direction As Long
Dim BKCOLOR As Long 'The BASE-Color, it must be defferent to the color of the edge
Const GrayDeff As Long = 150 'The defference of Color-Gray between the BASE-Color and the EDGE-Color
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal HRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Sub Command1_Click()
End SubPrivate Sub Form_Load()
BKCOLOR = Me.BackColor
DXY(0).X = 0
DXY(0).Y = -1
DXY(1).X = 1
DXY(1).Y = -1
DXY(2).X = 1
DXY(2).Y = 0
DXY(3).X = 1
DXY(3).Y = 1
DXY(4).X = 0
DXY(4).Y = 1
DXY(5).X = -1
DXY(5).Y = 1
DXY(6).X = -1
DXY(6).Y = 0
DXY(7).X = -1
DXY(7).Y = -1
With Me
OldWindow(0).X = .ScaleLeft
OldWindow(0).Y = .ScaleTop
OldWindow(1).X = .ScaleLeft + .ScaleWidth
OldWindow(1).Y = .ScaleTop
OldWindow(2).X = .ScaleLeft + .ScaleWidth
OldWindow(2).Y = .ScaleTop + .ScaleHeight
OldWindow(3).X = .ScaleLeft
OldWindow(3).Y = .ScaleTop + .ScaleHeight
End With
End SubPrivate Function FirstDot(ByVal X As Long, ByVal Y As Long) As Boolean
Dim X1 As Long
Dim Y1 As Long
Dim Wid As Long
Dim Hei As Long
Dim Col As Long
On Error Resume Next
With Picture1
BKCOLOR = .Point(X, Y)
Wid = .Width - 1
Hei = .Height - 1
For X1 = X To Wid '扫描第一个点的位置，注意：这里是先从上到下，再从左到右，所以开始Direction的初始值是4
For Y1 = Y To Hei
Col = .Point(X1, Y1)
If GetDeff(Col, BKCOLOR) > GrayDeff Then
Dot(0).X = X1 '第一个点的DotNumber总是0
Dot(0).Y = Y1 '所以直接写0而不写DotNumber了
GoTo Find
Else
BKCOLOR = Col
End If
Next
Next
Find:
DotNumber = 1
Direction = 4
End With
End FunctionPrivate Sub SeekEdge()
Dim DX As Long
Dim DY As Long
Dim I As Long
Dim L As Long
Dim LastDirection As Long
Dim Col As Long
LastDirection = 0
L = 0
Do
Direction = (Direction + 4) Mod 8 '在开始下以点的查找前，必须先把探测方向转180度
For I = 0 To 7
Direction = (Direction + 1) Mod 8
Dot(DotNumber).X = Dot(L).X + DXY(Direction).X
Dot(DotNumber).Y = Dot(L).Y + DXY(Direction).Y
If GetDeff(Picture1.Point(Dot(DotNumber).X, Dot(DotNumber).Y), BKCOLOR) > GrayDeff Then Exit For
Next
If Direction <> LastDirection Then '同方向点判断和压缩
L = DotNumber
DotNumber = L + 1
LastDirection = Direction
Else
Dot(L).X = Dot(DotNumber).X
Dot(L).Y = Dot(DotNumber).Y
'DotNumber = L
End If
Loop Until Dot(DotNumber).X = Dot(0).X And Dot(DotNumber).Y = Dot(0).Y Or DotNumber > 99999
End SubPrivate Sub PolyWindow(ByVal Restore As Boolean)
Dim HRgn As Long 'HWND of Region
If Restore Then
HRgn = CreatePolygonRgn(OldWindow(0), 4, 1)
Picture1.Cls
Else
HRgn = CreatePolygonRgn(Dot(0), DotNumber, 1)
MsgBox "Dot Number:" & DotNumber
End If
SetWindowRgn Me.hWnd, HRgn, True
DeleteObject HRgn
End SubPrivate Sub PolyLine()
Dim I As Long
Picture1.DrawMode = 7
Picture1.DrawWidth = 1
Picture1.AutoRedraw = True
For I = 1 To DotNumber
Picture1.Line (Dot(I - 1).X, Dot(I - 1).Y)-(Dot(I).X, Dot(I).Y)
Next
Picture1.DrawMode = 13
Picture1.DrawWidth = 2
Picture1.Refresh
End SubPrivate Function GetDeff(ByVal Col As Long, ByVal BKCol As Long) As Long
GetDeff = Abs((Col Mod 256) - (BKCol Mod 256))
GetDeff = GetDeff + Abs((Col \ 256 Mod 256) - (BKCol \ 256 Mod 256))
GetDeff = GetDeff + Abs((Col \ 65536) - (BKCol \ 65536))
End FunctionPrivate Sub Picture1_DblClick()
FirstDot MoveFrom.X, MoveFrom.Y
SeekEdge
'PolyLine
PolyWindow DotNumber < 3
End SubPrivate Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim A As String
If KeyCode = 13 Then
CommonDialog1.ShowOpen
A = CommonDialog1.FileName
If Trim(A) <> "" Then
Picture1.Picture = LoadPicture(A)
With Me
.Width = Picture1.Width / 1024 * 1440 * 12 '* 0.715
.Height = Picture1.Height / 768 * 1440 * 9 '* 0.715
OldWindow(0).X = .ScaleLeft
OldWindow(0).Y = .ScaleTop
OldWindow(1).X = .ScaleLeft + .ScaleWidth
OldWindow(1).Y = .ScaleTop
OldWindow(2).X = .ScaleLeft + .ScaleWidth
OldWindow(2).Y = .ScaleTop + .ScaleHeight
OldWindow(3).X = .ScaleLeft
OldWindow(3).Y = .ScaleTop + .ScaleHeight
End With
End If
End If
PolyWindow True
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MoveFrom.X = X
MoveFrom.Y = Y
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Col As Long
Col = Picture1.Point(X, Y)
Picture1.ToolTipText = X & ":" & Y & " >>" & GetDeff(Col, 0)
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MoveTo As Position
If Button = 1 Then
With Me
MoveTo.X = .Left + (X - MoveFrom.X) / 1024 * 1440 * 12 * 0.715 '15寸显示器宽为12寸，因为实际尺寸不到15寸所以要比实际少点
MoveTo.Y = .Top + (Y - MoveFrom.Y) / 768 * 1440 * 9 * 0.715 '15寸显示器宽为9寸
.Move MoveTo.X, MoveTo.Y
'MsgBox .Left & " " & .Top
End With
End If
If Button = 2 Then
Picture1.Line (MoveFrom.X, MoveFrom.Y)-(X, Y)
End If
End Sub'说明一下，这个程序有几个地方我偷懒了，一是移动无界面窗体的办法，因为我懒得查API就自己写了个土办法，可能显示器不是15寸的朋友在移动的时候会有点偏差。二是PictureBox控件中加载的图片不要太花哨，对比度要大一些，否则可能会裁下来很小很小的一个窗体，甚至小到你这个窗体只有1个像素，到时候找不到你的窗体可别怪我哦。对啦，差点忘了，鼠标双击图片的不同部位可以得到不同的裁剪效果。对着图片按着鼠标右键拖放，可以画一条直线，对着图片按键盘可以加载其他图片。
这个程序我使用了行程压缩的方法，所以比一般算法得到的不规则窗体的关键点少很多，可以加快执行的速度，但是因为我使用的边界探测算法不好，所以有的时候会因为找不到边界点造成死循环(建议大家用卡通画之类边界明显的图片来试会得到非常好的效果)，这不，我这里已经死循环了，要是有哪位高手可以给个好点的边界探测的算法，将不胜感激！对了，贴在这里或发信息给我都行！