请问vb窗体的形状可以用自定义的不规则形状的图片来代替吗?比如说窗体界面是一个用photoshop处理过的心形的图片,整个窗体是一个心形形状,这个功能如何实现?

解决方案 »

  1.   

    可不可以具体的说一下,winapi里面的几个函数好象只有几个形状,象矩形和椭圆,那其他不规则的怎么办,用哪个winapi函数来控制啊
      

  2.   

    可以实现的模块代码:
    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 = &HA1
    Public 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 Subform窗体:Private Sub Form_Load()
    'If Me.Picture <> 0 Then Call SetAutoRgn(Me)
    Me.Picture = LoadPicture(App.Path & "\m005.bmp")
    Call SetAutoRgn(Me)
    Me.Picture = LoadPicture(App.Path & "\005.jpg")End SubPrivate 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&
    End If
    If Button = vbRightButton Then
    PopupMenu Form2.main
    End If
    End Sub
      

  3.   

    这是将一张图形做成窗体,你如果要例子给我mail
    [email protected]
      

  4.   

    你说的是不能实现的,不过可以将窗体的形状改成奇形怪状的,ch21st的可以看看.