大家帮忙查查错!这是我的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为何总是不成功呢?
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为何总是不成功呢?
这是受窗口绘制方式的局限
Win2000可是重写了系统内核才实现的
http://cpb.cn/upfile/3069.rar
可否帮忙看一下!
是不是该窗口不能移动?
可以看到当这个FORM位于屏幕的偏左上方时,点COMMAND按钮,会发现该窗口仍被抓到背景图里了,这样就会导致背景色越积越深,导致最后不再清晰。
请大家帮忙,如何不让在抓屏时不把该窗口本身抓进去!
大家一运行就能看出来它还是把窗口给抓进来了!
Win98的WM_PAINT一次成像,根本来不及捕捉。
再就不知道了,你看看msdn中的说明,研究一下把,搞好了记得也给我们学习一下
给你提示,以前看过一篇文章,记不太清楚了,好象是拦截wm_erasebkgnd消息,在擦除背景时控制擦除的程度,就可以实现98下的半透明,效果很好,和楼主的思路不同,记得代码也很短…………
再就不知道了,你看看msdn中的说明,研究一下把,搞好了记得也给我们学习一下
===================================================用那种方法不能实现动态背景下的半透明效果
http://cpb.cn/upfile/3087.rar源码见下,请大家帮忙修改,看如何能解决闪烁的问题,闪屏主要是由于要抓屏的话就得先把当前窗口隐藏一下,否则会把该窗口自己也抓进去,这样一隐藏再一显示就会闪烁,不知该如何解决!
http://cpb.cn/upfile/3088.rar
(适用于WIN98/2K/XP)EXE见下:http://cpb.cn/upfile/3090.rar
(使用说明:将鼠标停留在窗体上片刻不动,看看有何效果)源码见下:http://cpb.cn/bbs.asp?collegeid=1&qid=11572&distitleid=11572&page=lastpage
就看到一长串的a、b、c、d、e、f我的操作系统是WinXP
这种自动隐藏的窗口当然好做
'
'本函数功能主要是通过设置窗体区域,来隐藏客户区,这样可以使透明时窗口闪烁轻一点
'
'******************************************************************************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