这么简单啊,不知道是不是真的啊,不过,还是告诉你一下把,看着给分啊:Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As _
        Long, lpRECT As RECT) As LongPrivate Declare Function GetClientRect Lib "user32" (ByVal hWnd As _
        Long, lpRECT As RECT) As LongPrivate Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As _
        Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal _
        nCombineMode As Long) As LongPrivate Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
        ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPrivate Declare Function ScreenToClient Lib "user32" (ByVal hWnd As _
        Long, lpPoint As POINTAPI) As LongPrivate Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As _
        Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As LongConst RGN_AND = 1
Const RGN_COPY = 5
Const RGN_DIFF = 4
Const RGN_OR = 2
Const RGN_XOR = 3Private Type POINTAPI
    x As Long
    Y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Sub DataSamp()
    Dim ad As Database
    Dim aserch As QueryDef
    
     
End SubPublic Sub MakeTransparent(frm As Form)
    Dim rctClient As RECT, rctFrame As RECT
    Dim hClient As Long, hFrame As Long
    
    '获得窗口矩形区域
    GetWindowRect frm.hWnd, rctFrame
    GetClientRect frm.hWnd, rctClient
    
    '将窗口矩形坐标转换为屏幕坐标
    Dim lpTL As POINTAPI, lpBR As POINTAPI
    lpTL.x = rctFrame.Left
    lpTL.Y = rctFrame.Top
    lpBR.x = rctFrame.Right
    lpBR.Y = rctFrame.Bottom
    ScreenToClient frm.hWnd, lpTL
    ScreenToClient frm.hWnd, lpBR
    rctFrame.Left = lpTL.x
    rctFrame.Top = lpTL.Y
    rctFrame.Right = lpBR.x
    rctFrame.Bottom = lpBR.Y
    rctClient.Left = Abs(rctFrame.Left)
    rctClient.Top = Abs(rctFrame.Top)
    rctClient.Right = rctClient.Right + Abs(rctFrame.Left)
    rctClient.Bottom = rctClient.Bottom + Abs(rctFrame.Top)
    rctFrame.Right = rctFrame.Right + Abs(rctFrame.Left)
    rctFrame.Bottom = rctFrame.Bottom + Abs(rctFrame.Top)
    rctFrame.Top = 0
    rctFrame.Left = 0
    
    
    hClient = CreateRectRgn(rctClient.Left, rctClient.Top, rctClient.Right, rctClient.Bottom)
    hFrame = CreateRectRgn(rctFrame.Left, rctFrame.Top, rctFrame.Right, rctFrame.Bottom)
    
    CombineRgn hFrame, hClient, hFrame, RGN_XOR
    
    SetWindowRgn frm.hWnd, hFrame, True
End SubPrivate Sub Form_Click()
    MakeTransparent Me
End Sub

解决方案 »

  1.   

    Option ExplicitPrivate 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 Sub ReleaseCapture Lib "User32" ()Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongConst WM_NCLBUTTONDOWN = &HA1
    Const HTCAPTION = 2Const WS_EX_LAYERED = &H80000
    Const GWL_EXSTYLE = (-20)
    Const LWA_ALPHA = &H2
    Const LWA_COLORKEY = &H1
    Private Sub Form_Load()
     DarkMe
     With Label1
      .WordWrap = True
      .Caption = " Drag Here "
     End With
     With Label2
       .Caption = "X"
       .Height = Label1.Height
       .Top = Label1.Top
     End With
    End SubPrivate Sub Image1_Click()End SubPrivate Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      If Button = vbLeftButton Then
           Call ReleaseCapture
           SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
      End If
    End SubPublic Function DarkMe()
        Dim rtn As Long
        rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
        rtn = rtn Or WS_EX_LAYERED
        SetWindowLong hWnd, GWL_EXSTYLE, rtn
        SetLayeredWindowAttributes hWnd, 0, 200, LWA_ALPHA
        '上面的200是透明度,0就完全透明,255就完全不透明
    End Function'在窗口上加一个image1,一个label1,一个label2 ,记住颜色不要设定成白色
    '记住给分啊,不然下次不帮啦。
      

  2.   

    上面label1拖动窗体,
    在label2 的click 事件上加上关闭的代码(随你便加不加都行啦)
      

  3.   

    可以调整自己 和 其他程序的 窗口透明率Option Explicit
    Private Const GWL_EXSTYLE = (-20)
    Private Const WS_EX_LAYERED = &H80000
    Private Const WS_EX_TRANSPARENT = &H20&
    Private Const LWA_ALPHA = &H2&
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPrivate Declare Function CallWindowProc Lib "user32" Alias _
        "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
        ByVal hwnd As Long, ByVal Msg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Const WM_ACTIVATEAPP = &H1C
    Private Const GWL_WNDPROC = -4
    Public lpPrevWndProc As Long
    Public gHW As Long
    Private Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
    End Type
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function GetWindowWord Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Integer
    Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPrivate Type POINTAPI
      x As Long
      Y As Long
    End TypePrivate Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Const SWP_NOMOVE = &H2, SWP_NOSIZE = &H1
    Private Const HWND_TOPMOST = -1, HWND_NOTOPMOST = -2
    Sub SetTopmostWindow(ByVal hwnd As Long, Optional topmost As Boolean = True)
        Const HWND_NOTOPMOST = -2
        Const HWND_TOPMOST = -1
        Const SWP_NOMOVE = &H2
        Const SWP_NOSIZE = &H1
        SetWindowPos hwnd, IIf(topmost, HWND_TOPMOST, HWND_NOTOPMOST), 0, 0, 0, 0, _
            SWP_NOMOVE + SWP_NOSIZE
        
    End Sub
    Private Sub Check1_Click()
        If Check1.Value = vbChecked Then
            SetTopmostWindow Me.hwnd, True
        Else
            SetTopmostWindow Me.hwnd, False
        End If
    End Sub
    Private Sub Command1_Click()
        If List1.ListIndex = -1 Then
            MsgBox "Select a window from the above list", vbExclamation, App.Title
            Exit Sub
        End If
    Dim NormalWindowStyle As Long
    Dim sSplit() As String
    Dim HWD As Long
        sSplit = Split(List1.Text, "|")
        HWD = CLng(sSplit(1))
        NormalWindowStyle = GetWindowLong(HWD, GWL_EXSTYLE)
        SetWindowLong HWD, GWL_EXSTYLE, NormalWindowStyle Or WS_EX_LAYERED    SetLayeredWindowAttributes HWD, 0, HS, LWA_ALPHA
    End SubPrivate Sub Command2_Click()
        Unload Me
        End
        
    End SubPrivate Sub Command3_Click()
        List1.Clear
        
    End SubPrivate Sub Form_Load()
        App.Title = "Set Window Transparency"
        Me.Caption = App.Title
        Check1_Click
    End SubPrivate Sub Picture1_Click()
        ShellExecute 0, vbNullString, "mailto:[email protected]", vbNullString, vbNullString, vbNormalFocusEnd SubPrivate Sub Timer1_Timer()
    Dim info As String
    info = GetInformation(Me.hwnd, List1.hwnd, Command1.hwnd, Command2.hwnd, Command3.hwnd, Check1.hwnd, HS.hwnd)
    If info > "" And Left(info, 1) <> "|" Then
        If Not isWindowInList(info) Then
            List1.AddItem info
        End If
    End If
    End Sub
    Function isWindowInList(ByVal sIN As String) As Boolean
    Dim x As Integer
        isWindowInList = False
        For x = 0 To List1.ListCount - 1
            If sIN = List1.List(x) Then
                isWindowInList = True
            End If
        Next x
    End Function
    Private Function GetInformation(ParamArray HwndExcluded() As Variant) As String
    On Error Resume NextDim CursorPos As POINTAPI
    Dim szText As String * 100
    Dim HoldText As String
    Dim HwndNow As Long, hInst As Long
    Dim Rct As RECT, R As Long
    Dim I
    Static HwndPrev As LongConst GWW_HINSTANCE = (-6), GWW_ID = (-12), GWL_STYLE = (-16)GetCursorPos CursorPosHwndNow = WindowFromPoint(CursorPos.x, CursorPos.Y)For I = LBound(HwndExcluded) To UBound(HwndExcluded)
      If HwndNow = CLng(HwndExcluded(I)) Then Exit Function
    Next I
    GetInformation = ""
    If HwndNow <> HwndPrev Then
      HwndPrev = HwndNow
      
      R = GetWindowText(HwndNow, szText, 100)
      GetInformation = Left(szText, R) & "|"
      GetInformation = GetInformation & HoldText & CStr(HwndNow) & "|"
      
      GetInformation = GetInformation & GetWindowWord(HwndNow, GWW_HINSTANCE)
    End If
    End Function
      

  4.   

    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    Private Const WS_EX_LAYERED = &H80000
    Private Const GWL_EXSTYLE = (-20)
    Private Const LWA_ALPHA = &H2
    Private Const LWA_COLORKEY = &H1
    Private Sub Form_Load()    Dim rtn As Long
        rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
        rtn = rtn Or WS_EX_LAYERED
        SetWindowLong hwnd, GWL_EXSTYLE, rtn
        SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHAEnd Sub
      

  5.   

    win98下没有一个可以用!
    SetLayeredWindowAttributes只有在win2000以上才有
    kiti(小胡桃) 的(第一个程序)是将窗体完全透明,而不是半透明!
    你们自己试一下吧!
      

  6.   

    有没有搞错?kiti(小胡桃)  的办法才是通用的。其他人的全部都是重复性回复!
    SetLayeredWindowAttributes只有在win2000以后版本里才存在。而且,如果实现全部透明,可以按照kiti(小胡桃)的办法再进行一步操作:扫描目标图形,只保留需要保留的Rgn,其他的都剪掉。
    我身边没有代码,谁有兴趣要这500分,
    贴一个通过扫描目标图片实现透明的例子就可以了。
      

  7.   

    win98下是没有api可以实于半透明的,但我以前下载过一个控件是可以在win98中实的。还可用图片方式实现半透明的不规则窗口。等一下我把它找出来。留个email.
      

  8.   

    还有好像用activeskin4.0也可实现,不过其自定义界面时我感觉比效烦
      

  9.   

    zhtcool(zhtcool)把Email给我,给你一个我编的98下透明的例子。
      

  10.   

    可参考“http://www.csdn.net/expert/topic/697/697578.xml?temp=.6467249”的代码
    在Timer控件中判断窗体位置,如果改变则再画一次背景用那篇帖子讲的方法
    可以实现背景是静态的半透明
    动态的无法实现其实微软都没有把Win98下背景是动态半透明编出来
    大家都知道,拖动文件的时候,文件的图标是半透明的
    如果你把桌面背景设为一动态Gif,再拖动桌面的图标,你会发现桌面背景的那幅动态Gif停止运动了
      

  11.   

    good_sun(八锖):
      能不能把你的代码在改一下啊,我想实现可以加入容器控件和不见控件的功能啊,因为我水平不高,不会自己改,呵呵,请再帮帮忙啊,最好代码能有详细的注释说明就最好了,  在次感谢
      
      改完后我将给分,给你500分,给kiti 100分,呵呵,不会失言的!!!
      

  12.   

    回复人: zhtcool(zhtcool) (  ) 信誉:100  2002-05-06 08:49:00  得分:0  
     
     
      good_sun(八锖):
      能不能把你的代码在改一下啊,我想实现可以加入容器控件和不见控件的功能啊,因为我水平不高,不会自己改,呵呵,请再帮帮忙啊,最好代码能有详细的注释说明就最好了,  在次感谢
      
      改完后我将给分,给你500分,给kiti 100分,呵呵,不会失言的!!!
     
    ====================================================================
    半透明的控件
    WinXP都不支持
    更别说可以作为容器的控件如果你非要作出那样的效果的话
    先找几本图像处理、游戏编程的书看看具体做法是:
    仿照编游戏界面的方法
    在一个PictureBox中绘制“控件”(不是真正的控件,是你画出来的)
    并根据鼠标键盘消息处理控件图像(如你的按键按下)为了好调用,可以把那些“控件”放在类模块中
    需要是再生成
      

  13.   

    'module
    Option ExplicitPublic Const RGN_AND = 1
    Public Const RGN_COPY = 5
    Public Const RGN_DIFF = 4
    Public Const RGN_OR = 2
    Public Const RGN_XOR = 3Public Type POINTAPI
        X As Long
        Y As Long
    End Type
    Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
    '区域的设置与获取
    Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    '合并区域
    Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As LongPublic Sub GetFormRect(ByVal frm As Form, ByRef rctframe As RECT, ByRef rctclient As RECT)
        
        '获得窗口矩形区域
        GetWindowRect frm.hwnd, rctframe
        GetClientRect frm.hwnd, rctclient
        
        '将窗口矩形坐标转换为屏幕坐标
        Dim lpTL As POINTAPI, lpBR As POINTAPI
        lpTL.X = rctframe.Left
        lpTL.Y = rctframe.Top
        lpBR.X = rctframe.Right
        lpBR.Y = rctframe.Bottom
        ScreenToClient frm.hwnd, lpTL
        ScreenToClient frm.hwnd, lpBR
        rctframe.Left = lpTL.X
        rctframe.Top = lpTL.Y
        rctframe.Right = lpBR.X
        rctframe.Bottom = lpBR.Y
        rctclient.Left = Abs(rctframe.Left)
        rctclient.Top = Abs(rctframe.Top)
        rctclient.Right = rctclient.Right + Abs(rctframe.Left)
        rctclient.Bottom = rctclient.Bottom + Abs(rctframe.Top)
        rctframe.Right = rctframe.Right + Abs(rctframe.Left)
        rctframe.Bottom = rctframe.Bottom + Abs(rctframe.Top)
        rctframe.Top = 0
        rctframe.Left = 0End Sub'form1
    Option ExplicitPrivate Sub Command1_Click()
    Dim X As Long
    Dim Y As Long
    Dim r1 As RECT
    Dim r2 As RECT
    Dim lngR1 As Long
    Dim lngRTemp As LongGetFormRect Me, r1, r2
    lngR1 = CreateRectRgn(r1.Left, r1.Top, r1.Right, r1.Bottom)For X = 0 To Abs(r2.Right - r2.Left) Step 3
        For Y = 0 To Abs(r2.Bottom - r2.Top) Step 3
            lngRTemp = CreateRectRgn(X + Abs(r2.Left), Y + Abs(r2.Top), X + Abs(r2.Left) + 1, Y + Abs(r2.Top) + 1)
            CombineRgn lngR1, lngR1, lngRTemp, RGN_XOR
        Next Y
    Next XSetWindowRgn Me.hwnd, lngR1, True
    End Sub
    '点完了按钮要等一会噢,效果不算好,不过呢,真正的半透明也不好作~
    '效果挺有趣的
      

  14.   

    www.myvc.net是一个编程技术论坛,为广大编程爱好者提供一个交流技术的空间!
    现在,www.myvc.net将为大家提供一个资源下载的空间!第一批将提供<三层结构源代码>
    <开发文档模版>两项。
    需要者可去以下网址留下email
    http://www.myvc.net/dispbbs.asp?boardID=16&RootID=658&ID=658&page=1
    我们也提供资源上传的空间,如果你愿意和大家分享你的资源,你可以和www.myvc.net联系