请问，如何用VB实现不规则的窗体（根据图片的形状自动变化，拖拽时不会出现边框

Question

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "SetWindowRgn Demo"
   ClientHeight    =   2655
   ClientLeft      =   1260
   ClientTop       =   1560
   ClientWidth     =   6135
   ClipControls    =   0   'False
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   177
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   409
   Begin VB.CommandButton Command1 
      Caption         =   "Push Me"
      BeginProperty Font 
         Name            =   "Comic Sans MS"
         Size            =   14.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   840
      TabIndex        =   2
      Top             =   720
      Width           =   1455
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Winding"
      Height          =   255
      Index           =   1
      Left            =   1320
      TabIndex        =   1
      Top             =   120
      Width           =   1095
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Alternate"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Value           =   -1  'True
      Width           =   1095
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   120
      Top             =   720
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' *********************************************************************
'  Copyright ?996-98 Karl E. Peterson, All Rights Reserved
' *********************************************************************
'  You are free to use this code within your own applications, but you
'  are expressly forbidden from selling or otherwise distributing this
'  source code without prior written consent.
' *********************************************************************
Option ExplicitPrivate Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, 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 CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function Polyline Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End TypePrivate Type POINTAPI
   X As Long
   Y As Long
End TypePrivate scnPts() As POINTAPI
Private rgnPts() As POINTAPIPrivate Const SM_CYCAPTION = 4
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33' PolyFill() Modes
Private Const ALTERNATE = 1
Private Const WINDING = 2' Used to support captionless drag
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
' Undocumented message constant.
Private Const WM_GETSYSMENU = &H313Private m_FillMode As Long
Private Const nPts& = 36

Answer 1

Private Sub Command1_Click()
   Dim hRgn As Long
   Static UsingPoly As Boolean
   '
   ' Flag variable tracks current state.
   '
   UsingPoly = Not UsingPoly
   If UsingPoly Then
      '
      ' Create a region, then turn on
      ' clipping to that region.
      '
      hRgn = CreatePolygonRgn(rgnPts(0), nPts, m_FillMode)
      Call SetWindowRgn(Me.hWnd, hRgn, True)
   Else
      '
      ' Turn off clipping.
      '
      Call SetWindowRgn(Me.hWnd, 0&, True)
   End If   Timer1.Enabled = UsingPoly
End SubPrivate Sub Form_Load()
   m_FillMode = ALTERNATE
   With Me
      .ScaleMode = vbPixels
      .Width = Screen.Width \ 2
      .Height = .Width
      .Move (Screen.Width - .Width) \ 2, (Screen.Height - .Height) \ 2
      .Icon = Nothing
   End With
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   '
   ' Allow captionless drag if form is clipped to region
   '
   If Button = vbLeftButton Then
      If Timer1.Enabled Then
         Call ReleaseCapture
         Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&)
      End If
   End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim pt As POINTAPI
   
   ' This is relative to the screen, so we can't
   ' use the coordinates passed in the event
   Call GetCursorPos(pt)
   
   If Button = vbRightButton Then
      If Timer1.Enabled Then
         Call SendMessage(Me.hWnd, WM_GETSYSMENU, 0, ByVal MakeLong(pt.Y, pt.X))
      End If
   End If
End SubPrivate Sub Form_Paint()
   Dim hBrush As Long
   Dim hRgn As Long
   '
   ' Create region and a brush to fill it with.
   '
   hBrush = CreateSolidBrush(vbRed)
   hRgn = CreatePolygonRgn(scnPts(0), nPts, m_FillMode)
   Call FillRgn(Me.hDC, hRgn, hBrush)
   '
   ' Clean up GDI objects.
   '
   Call DeleteObject(hRgn)
   Call DeleteObject(hBrush)
   '
   ' Draw outline around polygon.
   '
   Call Polyline(Me.hDC, scnPts(0), nPts + 1)
End SubPrivate Sub Form_Resize()
   With Me
      Command1.Move (.ScaleWidth - Command1.Width) \ 2, _
                    (.ScaleHeight - Command1.Height) \ 2
      If .Visible Then
         CalcRgnPoints
         .Refresh
      End If
   End With
End SubPrivate Static Sub CalcRgnPoints()
   ReDim scnPts(0 To nPts) As POINTAPI
   ReDim rgnPts(0 To nPts) As POINTAPI
   Dim offset As Long
   Dim angle As Long
   Dim theta As Double
   Dim radius1 As Long
   Dim radius2 As Long
   Dim x1 As Long
   Dim y1 As Long
   Dim xOff As Long
   Dim yOff As Long
   Dim n As Long
   '
   ' Some useful constants.
   '
   Const Pi# = 3.14159265358979
   Const DegToRad# = Pi / 180
   '
   ' Calc radius based on form size.
   '
   x1 = Me.ScaleWidth \ 2
   y1 = Me.ScaleHeight \ 2
   If x1 > y1 Then
      radius1 = y1 * 0.85
   Else
      radius1 = x1 * 0.85
   End If
   radius2 = radius1 * 0.5
   '
   ' Offsets to move origin to upper
   ' left of window.
   '
   xOff = GetSystemMetrics(SM_CXFRAME)
   yOff = GetSystemMetrics(SM_CYFRAME) + GetSystemMetrics(SM_CYCAPTION)
   '
   ' Step through a circle, 10 degrees each
   ' loop, finding points for polygon.
   '
   n = 0
   For angle = 0 To 360 Step 10
      theta = (angle - offset) * DegToRad
      '
      ' First region is for drawing.
      ' One long, one short, one long...
      '
      If n Mod 2 Then
         scnPts(n).X = x1 + (radius1 * (Sin(theta)))
         scnPts(n).Y = y1 + (radius1 * (Cos(theta)))
      Else
         scnPts(n).X = x1 + (radius2 * (Sin(theta)))
         scnPts(n).Y = y1 + (radius2 * (Cos(theta)))
      End If
      '
      ' Second region is for clipping.
      ' Add offsets.
      '
      rgnPts(n).X = scnPts(n).X + xOff
      rgnPts(n).Y = scnPts(n).Y + yOff
      n = n + 1
   Next angle   offset = (offset + 2) Mod 360
End SubPrivate Sub Option1_Click(Index As Integer)
   m_FillMode = Index + 1
End SubPrivate Static Sub Timer1_Timer()
   Dim nRet As Long
   Dim hRgn As Long   CalcRgnPoints
   hRgn = CreatePolygonRgn(rgnPts(0), nPts, m_FillMode)
   nRet = SetWindowRgn(Me.hWnd, hRgn, True)
End SubPublic Function MakeLong(ByVal WordHi As Variant, ByVal WordLo As Integer) As Long
   '
   ' High word is coerced to a variant on call to allow
   ' it to overflow limits of multiplication which shifts
   ' it left.
   '
   MakeLong = (WordHi * &H10000) + (WordLo And &HFFFF&)
End Function

Answer 2

你的意思是使用Api移动无标题窗体时的那个虚框吧？
解决方法有两个。
一：显示属性＝》效果＝》视觉效果果＝》拖动时显示窗体内容 选中。
二：不使用Api移动窗体。用下面的代码试试
    Dim oldX As Long, oldY As Long
    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        oldX = X
        oldY = Y
     End Sub     Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
         If Not Button = 1 Then Exit Sub
         Left = Left - (oldX - X)
         Top = Top - (oldY - Y)
      End Sub
推荐使用第二种方法。

Answer 3

我的代码在：http://bib.archtide/detail.asp?id=283
http://www.archtide.com/detail.asp?id=403

Answer 4

http://www.archtide.com/detail.asp?id=283不好意思，第一个贴错了