关于VB窗体形状的问题

Question

其实没你想象的那么简单，
任意形状的窗体，需要两张预先处理好的图片，
这两张图片分别为前景图和去前景图，
然后你就查api中的BitBlr()吧

Answer 1

Public Function SetFormRgn(Frm As Form, Pic As Long, Optional TransColor As Long = vbNull)
    Dim NewDC As Long, SPic As Long, cPic As Long, err As Long
    Dim Bm As BITMAP
    GetObject Pic, Len(Bm), Bm
    cPic = CopyImage(Pic, IMAGE_BITMAP, Bm.bmWidth, Bm.bmHeight, LR_CREATEDIBSECTION)
    NewDC = CreateCompatibleDC(Frm.hdc)
    SPic = SelectObject(NewDC, cPic)
        
    Dim X As Long, Y As Long
    Dim Rgn1 As Long, Rgn2 As Long
    Dim Pos1 As Long, Pos2 As Long
    Dim xOff As Long, yOff As Long
    
    If TransColor = vbNull Then TransColor = GetPixel(NewDC, 0, 0)
    Rgn1 = CreateRectRgn(0, 0, 0, 0)
    
    With Frm
        .ScaleMode = vbPixels
        xOff = (.ScaleX(.width, vbTwips, vbPixels) - .ScaleWidth) / 2
        yOff = .ScaleY(.height, vbTwips, vbPixels) - .ScaleHeight - xOff
        .width = (Bm.bmWidth + xOff * 2) * Screen.TwipsPerPixelX
        .height = (Bm.bmHeight + xOff + yOff) * Screen.TwipsPerPixelY
    End With
    
    
    For Y = 0 To Bm.bmHeight - 1
        X = 0
        Do
            While GetPixel(NewDC, X, Y) = TransColor And X < Bm.bmWidth
                X = X + 1
            Wend
            Pos1 = X
            
            While GetPixel(NewDC, X, Y) <> TransColor And X < Bm.bmWidth
                X = X + 1
            Wend
            Pos2 = X - 1
            
            If Pos1 <= Pos2 Then
                Rgn2 = CreateRectRgn(Pos1 + xOff, Y + yOff, Pos2 + 1 + xOff, Y + 1 + yOff)
                CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
                DeleteObject Rgn2
            End If
        Loop Until X >= Bm.bmWidth
    Next Y
    
    SetWindowRgn Frm.hWnd, Rgn1, True
    DeleteObject Rgn1
    
    
    err = SelectObject(NewDC, SPic)
    err = DeleteObject(cPic)
    err = DeleteObject(SPic)
    err = DeleteDC(NewDC)
End Functionapi自己包含吧

Answer 2

应该是有一个类似于TransparentBlt的函数通过指定屏蔽色
获得屏幕区语句柄
然后用下面这个函数
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long挺简单的,但是我记不清了,要回家查资料~~~~~
你自己喳喳MSDN应该有的

Answer 3

其实用背景图作窗体也很简单，只是想用风景图作窗体效果不是太好，你可以用作图软件进行图象处理，然后再作背景，但背景图片最好是3D的或者是材质较好的。下面给你一个例子：
Form1的代码：'************************************************************************************************************************
'
'                                    Chinafish 2002.8.19
'
'
'
'
'                                         BKSoftware
'
'
'
'
'
'************************************************************************************************************************Private Sub Form_Load()Form1.Left = Screen.Width / 2 - Form1.Width / 2
Form1.Top = Screen.Height / 2 - Form1.Height / 2If Me.Picture <> 0 Then Call SetAutoRgn(Me)End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
Else
If Button = vbRightButton Then
End
End If
End If
End Sub添加一个Module，代码：
'************************************************************************************************************************
'
'                                    Chinafish 2002.8.19
'
'
'
'
'                                         BKSoftware
'
'
'
'
'
'************************************************************************************************************************
Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As LongPublic Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPublic Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As LongPublic Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPublic Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As LongPublic Const RGN_OR = 2Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End TypeDim bmByte() As BytePublic Declare Function ReleaseCapture Lib "user32" () As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long'Public Const WM_SYSCOMMAND = &H112
'Public Const SC_MOVE = &HF012
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1Public Sub SetAutoRgn(hForm As Form, Optional transColor As Byte = vbNull)
Dim X As Long, Y As Long
Dim Rgn1 As Long, Rgn2 As Long
Dim SPos As Long, EPos As Long
Dim bm As BITMAP
Dim hbm As Long
Dim Wid As Long, Hgt As Long
Dim xoff As Long, yoff As Long
hbm = hForm.Picture
GetObjectAPI hbm, Len(bm), bm
Wid = bm.bmWidth
Hgt = bm.bmHeight
ReDim bmByte(1 To Wid, 1 To Hgt)
GetBitmapBits hbm, Wid * Hgt, bmByte(1, 1) '获取图像数组
'如果没有传入transColor参数，则用第一个像素作为透明色
If transColor = vbNull Then transColor = bmByte(1, 1)Rgn1 = CreateRectRgn(0, 0, 0, 0)For Y = 1 To Hgt '逐行扫描
X = 0
Do
X = X + 1While (bmByte(X, Y) = transColor) And (X < Wid)
X = X + 1 '跳过是透明色的点
Wend
SPos = X
While (bmByte(X, Y) <> transColor) And (X < Wid)
X = X + 1 '跳过不是透明色的点
Wend
EPos = X - 1'这一段是合并区域
If SPos <= EPos Then
Rgn2 = CreateRectRgn(SPos - 1, Y - 1, EPos, Y)
CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
DeleteObject Rgn2
End If
Loop Until X >= Wid
Next YSetWindowRgn hForm.hwnd, Rgn1, True '设定窗体形状区域
DeleteObject Rgn1End Sub
注意窗体北京如果不清可以换一个立体图形试一下，这种算法不适于背景为风景等图片。