大家帮忙查查错!这是我的FORM1的代码:Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal dreamAKA As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateDC Lib "Gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function DeleteDC Lib "Gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongConst m_def_BlendColor = &HFFC0FFDim m_BlendColor As OLE_COLOR
Private Const SM_CYCAPTION = 4
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33
Dim xx As Integer, yy As IntegerPublic Sub drawTranslucency(frm As Object)
'frm.Refresh
Dim titleBarheight As Integer
Dim xDeviation As Integer
Dim yDeviation As Integer
Dim windowFrameHeight As Integer
Dim windowframewidth As Integer
Dim BlendVal As Long
Dim hDCscr As Long
Dim bhandle As Long
Dim hdest As Longfrm.AutoRedraw = TrueIf frm.BorderStyle <> 0 Then
titleBarheight = GetSystemMetrics(SM_CYCAPTION)
windowFrameHeight = GetSystemMetrics(SM_CYFRAME)
windowframewidth = GetSystemMetrics(SM_CXFRAME)
yDeviation = titleBarheight + windowFrameHeight
xDeviation = windowframewidth
Else
yDeviation = 0
xDeviation = 0
End Iffrm.BackColor = m_BlendColorfrm.Visible = FalsehDCscr = CreateDC("DISPLAY", "", "", 0)
hdest = CreateCompatibleDC(hDCscr)
bhandle = CreateCompatibleBitmap(hDCscr, frm.ScaleWidth, frm.ScaleHeight)
SelectObject hdest, bhandleBitBlt hdest, 0, 0, frm.ScaleWidth, frm.ScaleHeight, hDCscr, frm.Left / Screen.TwipsPerPixelX + xDeviation, frm.Top / Screen.TwipsPerPixelY + yDeviation, vbSrcCopy 'vbSrcErasefrm.Visible = True
frm.BackColor = m_BlendColor
frm.ClsBlendVal = 11796480AlphaBlend frm.hdc, 0, 0, frm.ScaleWidth, frm.ScaleHeight, hdest, 0, 0, frm.ScaleWidth, frm.ScaleHeight, 11796480DeleteDC hdest
ReleaseDC 0, hDCscr
DeleteObject bhandle
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'If Button = 1 Then xx = X: yy = Y
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'If Button = 1 Then
 '  ReleaseCapture
  ' SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
'End If
  'If Button = 1 Then
    'Move Left + X - xx, Top + Y - yy
  'End If
End SubPrivate Sub Command1_Click()
drawTranslucency Form1
End SubPrivate Sub Form_Load()
m_BlendColor = m_def_BlendColor
Image1.Move 0, 0
drawTranslucency Form1
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
drawTranslucency Form1
End Sub这是我的FORM2的代码:Private Sub Command1_Click()
Form1.Left = Form1.Left - 1000
Form1.drawTranslucency Form1
End SubPrivate Sub Form_Load()
Form1.Show
End Sub编译出来的EXE为何总是不成功呢?

解决方案 »

  1.   

    主要症状是:FORM2中的COMMAND按钮一开始点还能透明,多点几下后就无法透明了,颜色开始变得模糊! 是不是在调用完AlphaBlend后还要对FORM1进行什么特殊处理?目前只是进行了form1.cls清除操作。
      

  2.   

    Win9X无法实现完美的半透明效果
    这是受窗口绘制方式的局限
    Win2000可是重写了系统内核才实现的
      

  3.   

    可是PB版的HJD_CW高手用DELPHI做了一个DLL,基本可以解决这个问题,但是还有一点问题,由于我现在联系不到他,所以暂时没有办法,我的程序的原理很简单,就是落实的时候一开始可以透明,后来多点几下后就变模糊了。这个应该不是受窗口绘制方式的问题。因为程序的原理就是抓下屏幕图片赋给FORM的HDC,我想既然一开始能透明,后面就肯定仍能透明,只是某些关节尚未打开!烦请帮忙! 而且金山词霸在WIN98下也能实现半透明,不知是如何实现的?
      

  4.   

    我的EXE在:
    http://cpb.cn/upfile/3069.rar
    可否帮忙看一下!
      

  5.   

    "金山词霸在WIN98下也能实现半透明"
    是不是该窗口不能移动?
      

  6.   

    呵呵,不能完美就不完美吧,先麻烦您帮我把这个基本功能给解决掉,现在最大的问题就是:我的FORM2里的按钮点第一次是透明的,多点几次后渐渐变模糊,再继续点它又会变清晰起来,不知为何。
      

  7.   

    3069.rar运行了一下,click一下闪一下,不舒服。理想的半透明我是这样理解的:如果半透明窗口为置顶窗口,无论是自身窗口拖动还是它下面的窗口拖动,都表现为半透明,而且不闪。
      

  8.   

    我找到原因了,即使我先把FORM隐藏起来再抓屏幕,仍会把这个FORM给抓进去,具体大家请运行这个附件!
    可以看到当这个FORM位于屏幕的偏左上方时,点COMMAND按钮,会发现该窗口仍被抓到背景图里了,这样就会导致背景色越积越深,导致最后不再清晰。
    请大家帮忙,如何不让在抓屏时不把该窗口本身抓进去!
      

  9.   

    新的EXE附件见:http://cpb.cn/upfile/3079.rar
    大家一运行就能看出来它还是把窗口给抓进来了!
      

  10.   

    几乎不可能。
    Win98的WM_PAINT一次成像,根本来不及捕捉。
      

  11.   

    Windows2000/XP里面窗口的作图全部都要通过系统总控,所以在切换用户的时候原用户的窗口不会显示出来,而透明窗口,窗口阴影等的实现相对简单。
      

  12.   

    给你提示,以前看过一篇文章,记不太清楚了,好象是拦截wm_erasebkgnd消息,在擦除背景时控制擦除的程度,就可以实现98下的半透明,效果很好,和楼主的思路不同,记得代码也很短…………
      再就不知道了,你看看msdn中的说明,研究一下把,搞好了记得也给我们学习一下
      

  13.   

    回复人: hisofty(瘦马) ( ) 信誉:100  2003-08-13 21:34:00  得分:0 
     
     
      给你提示,以前看过一篇文章,记不太清楚了,好象是拦截wm_erasebkgnd消息,在擦除背景时控制擦除的程度,就可以实现98下的半透明,效果很好,和楼主的思路不同,记得代码也很短…………
      再就不知道了,你看看msdn中的说明,研究一下把,搞好了记得也给我们学习一下
      
     
    ===================================================用那种方法不能实现动态背景下的半透明效果
      

  14.   

    最新状况:EXE已经初步成型,就是抖动大了点,失败,EXE见下!  
    http://cpb.cn/upfile/3087.rar源码见下,请大家帮忙修改,看如何能解决闪烁的问题,闪屏主要是由于要抓屏的话就得先把当前窗口隐藏一下,否则会把该窗口自己也抓进去,这样一隐藏再一显示就会闪烁,不知该如何解决!  
    http://cpb.cn/upfile/3088.rar
      

  15.   

    最新进展:半透明 + 气泡提示
    (适用于WIN98/2K/XP)EXE见下:http://cpb.cn/upfile/3090.rar
    (使用说明:将鼠标停留在窗体上片刻不动,看看有何效果)源码见下:http://cpb.cn/bbs.asp?collegeid=1&qid=11572&distitleid=11572&page=lastpage
      

  16.   

    ???3087.rar没有透明啊
    就看到一长串的a、b、c、d、e、f我的操作系统是WinXP
      

  17.   

    原来是指ToolTip啊
    这种自动隐藏的窗口当然好做
      

  18.   

    我觉得不太可能。要么就是严重牺牲程序的效率。为什么那个Trans.exe连NC区都要重画?用SetWindowRgn去掉中间的客户区,截图,再用SetWindowRgn放上去,再画好,应该不会对NC区有影响。在XP下明显看到NC区不断地在经典和XP风格间跳闪。
      

  19.   

    pigpag(噼里啪啦),http://cpb.cn/upfile/3087.rar 已经不再重画NONCLIENT区了,不知您运行的是不是3087.rar,其隐藏时设置RGN的代码如下:Public Sub HideWindow(frm As Form)'******************************************************************************
    '
    '本函数功能主要是通过设置窗体区域,来隐藏客户区,这样可以使透明时窗口闪烁轻一点
    '
    '******************************************************************************Dim rgn As Long
      
      Dim rctClient As RECT, rctFrame As RECT
      Dim hClient As Long, hFrame As Long
      Dim lpTL As POINTAPI, lpBR As POINTAPI
      
        GetWindowRect frm.hwnd, rctFrame
        GetClientRect frm.hwnd, rctClient    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 Sub
      

  20.   

    如果想实现背景是动态的情况下的半透明恐怕得好好研究一下WINDOWS的消息系统先了,以后再说吧,我的本意也就是想做个半透明的气泡提示,至于半透明的窗体大家再慢慢讨论吧,:)
      

  21.   

    ActiveSkin 控件 可以做到
      

  22.   

    先UP,然后请大家看看下面的。http://expert.csdn.net/Expert/topic/2198/2198945.xml?temp=.8682825