★★★★★200分★★★★★求在屏幕中画一个半透明的带HWND任意的控件.

Question

在屏幕中,我在一个按钮上按下MOUSE,再移动,屏幕上要出现这个按钮的半透明图像,MOUSE移动时,这个半透明图像也跟着移动.
半透明图像要求它的样子和被拖动的控件图像要一样,例如:如果按钮上有"Command1"的标题,这个半透明图像也要有这个标题.如何实现这种特殊效果呢?请各位大虾位旨教...谢谢..

Answer 1

有缘啊兄弟，我临时为你写的，大致的、主要的过程就是这些了，细节上你再处理一下吧，比如资源释放鼠标指针在显示的图像里居中等等：
    与上次你问的画线问题一样，需要窗体的ClipControls = False
    Me.ScaleMode = 3    在窗体上放个命令按钮，你会很容易地将其改为一个过程，为过程传递控件的hwnd即可。Option ExplicitPrivate Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type POINTAPI
    x As Long
    y As Long
End TypePrivate Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As LongPrivate Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongDim ox As Long, oy As Long
Dim hdcControl As Long
Dim recControl As RECT
Dim hdcForm As LongPrivate Sub CreateHdc(hwnd As Long)
    Dim mbitmap As Long
    
    hdcControl = CreateCompatibleDC(Me.hdc)
    GetClientRect hwnd, recControl
    mbitmap = CreateCompatibleBitmap(Me.hdc, recControl.Right - recControl.Left, recControl.Bottom - recControl.Top)
    SelectObject hdcControl, mbitmap
    BitBlt hdcControl, 0, 0, recControl.Right - recControl.Left, recControl.Bottom - recControl.Top, GetDC(hwnd), 0, 0, vbSrcCopy
    DeleteObject mbitmap
    
    
    hdcForm = CreateCompatibleDC(Me.hdc)
    mbitmap = CreateCompatibleBitmap(Me.hdc, Me.ScaleWidth, Me.ScaleHeight)
    SelectObject hdcForm, mbitmap
    BitBlt hdcForm, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Me.hdc, 0, 0, vbSrcCopy
    DeleteObject mbitmap
End SubPrivate Sub Command1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    CreateHdc Command1.hwnd
End SubPrivate Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    Dim p As POINTAPI
    
    If Button = vbLeftButton Then
        BitBlt Me.hdc, ox, oy, recControl.Right - recControl.Left, recControl.Bottom - recControl.Top, hdcForm, ox, oy, vbSrcCopy
        
        GetCursorPos p
        ScreenToClient Me.hwnd, p        AlphaBlend Me.hdc, p.x, p.y, recControl.Right - recControl.Left, recControl.Bottom - recControl.Top, hdcControl, 0, 0, recControl.Right - recControl.Left, recControl.Bottom - recControl.Top, CLng(Val("&h" & Hex(75) & "00" & "00"))        ox = p.x: oy = p.y
    End If
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   BitBlt Me.hdc, ox, oy, recControl.Right - recControl.Left, recControl.Bottom - recControl.Top, hdcForm, ox, oy, vbSrcCopy
End SubPrivate Sub Form_Unload(Cancel As Integer)
    DeleteDC hdcForm
    DeleteDC hdcControl
End Sub

Answer 2

我的问题可以解决,先要感谢的是 songyaowu兄弟,但还有一个小问题,如果按钮换为标签,它是没有hwnd的,又如何去解决呢?

Answer 3

Label 和 image 控件其实是后来画上去的所以没有hwnd,它们算不上真正的控件你可以把Label放在PictureBox里,然后对PictureBox操作

Answer 4

呵呵,不行的.我的思路是在MOVEDOWN时直接在窗体上取出label的图像.
但是这个使用什么函数呢?

Answer 5

楼主在Delphi区那个说Access比Delphi好的高楼已经超过1千层了，呵呵

Answer 6

兄弟，你在题目里写的是要有hwnd的控件啊！
如果你想使label这些轻量控件也达到此效果的话也可以，但需要变通一下，方法是先获得窗口的句柄，这在我写的过程中已经有了。然后求出label控件在窗口中的位置，这可以通过label的left、top、width和height属性计算出来，这样用bitblt从窗口句柄中绘制相应位置的图像就可以了。

Answer 7

自己画不一样吗？就不用先获得窗口的句柄，再求出label控件在窗口中的位置了

Answer 8

SONGYAOWU的想法和我的一样.嘻,可以结贴了.谢谢你了.