大家可以看一下,这是DESKPINS添加规则后,把焦点拖到MEDIA PLAYER 后MEDIEA PLAYER的窗体发生了闪动。大家注意,我们用一般的让窗体闪动的软件是达不到这样的效果的,只能是一个矩形(跟拖动MEDIEA PLAYER时所产生的虚框一样大。)。http://img263.photo.163.com/biku/31501462/833572152.jpg http://img263.photo.163.com/biku/31501462/833571610.jpg
勾选图形主要算法 Public Sub FrameWindow(ByVal hWnd As Long, Optional PenWidth As Long = 2) Dim hDC As Long Dim hRgn As Long Dim hPen As Long Dim hOldPen As Long Dim hBrush As Long Dim hOldBrush As Long Dim OldMixMode As Long Dim cxFrame As Long Dim cyFrame As Long Dim r As RECT If IsWindow(hWnd) Then hDC = GetWindowDC(hWnd) hRgn = CreateRectRgn(0, 0, 0, 0) hPen = CreatePen(PS_INSIDEFRAME, GetSystemMetrics(SM_CXBORDER) * PenWidth, RGB(0, 0, 0)) hOldPen = SelectObject(hDC, hPen) hOldBrush = SelectObject(hDC, GetStockObject(NULL_BRUSH)) OldMixMode = SetROP2(hDC, R2_NOT) If GetWindowRgn(hWnd, hRgn) <> ERRORAPI Then hBrush = CreateHatchBrush(HS_DIAGCROSS, GetSysColor(CTLCOLOR_STATIC)) Call FrameRgn(hDC, hRgn, hBrush, GetSystemMetrics(SM_CXBORDER) * PenWidth, GetSystemMetrics(SM_CYBORDER) * PenWidth) Else cxFrame = GetSystemMetrics(SM_CXFRAME): cyFrame = GetSystemMetrics(SM_CYFRAME) Call GetWindowRect(hWnd, r) If IsZoomed(hWnd) Then Call Rectangle(hDC, cxFrame, cyFrame, GetSystemMetrics(SM_CXSCREEN) + cxFrame, GetSystemMetrics(SM_CYSCREEN) + cyFrame) Else Call Rectangle(hDC, 0, 0, r.Right - r.Left, r.Bottom - r.Top) End If End If 'Cleanup Call SelectObject(hDC, hOldPen) Call SelectObject(hDC, hOldBrush) Call SetROP2(hDC, OldMixMode) Call DeleteObject(hPen) Call DeleteObject(hBrush) Call DeleteObject(hRgn) Call ReleaseDC(hWnd, hDC) End If End Sub
完整代码,测试通过 窗体: Option Explicit Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function WindowFromPointXY Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long Private Type POINTAPI x As Long y As Long End Type Private m_hWnd As Long Private m_Picking As Boolean Private Sub Form_Load() Picture1.Picture = Picture1.DragIcon Me.MouseIcon = Picture1.DragIcon End Sub Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Me.MousePointer = vbCustom Set Picture1.Picture = Nothing m_Picking = True Call SetCapture(Picture1.hWnd) End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Static pt As POINTAPI Static hWnd As Long
If m_Picking Then Call GetCursorPos(pt) hWnd = WindowFromPointXY(pt.x, pt.y) If hWnd <> m_hWnd Then ' Erase previous highlight. Call FrameWindow(m_hWnd) ' Cache new handle, update caption, and highlight. m_hWnd = hWnd Me.Caption = Hex(m_hWnd) Call FrameWindow(m_hWnd) End If End If End Sub Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) ' have done picking m_Picking = False
MsgBox Hex(m_hWnd) End Sub 模块: Option ExplicitPrivate Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long Private Declare Function SetROP2 Lib "gdi32" (ByVal hDC As Long, ByVal nDrawMode As Long) As Long Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long) As Long Private Declare Function FrameRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Private Const PS_INSIDEFRAME As Long = 6 Private Const SM_CXSCREEN As Long = 0 Private Const SM_CYSCREEN As Long = 1 Private Const SM_CXBORDER As Long = 5 Private Const SM_CYBORDER As Long = 6 Private Const SM_CXFRAME As Long = 32 Private Const SM_CYFRAME As Long = 33 Private Const NULL_BRUSH As Long = 5 Private Const NULL_PEN As Long = 8 Private Const R2_NOT As Long = 6 Private Const HS_DIAGCROSS As Long = 5 Private Const CTLCOLOR_STATIC As Long = 6 Private Const ERRORAPI As Long = 0 Private Const NULLREGION As Long = 1 Private Const SIMPLEREGION As Long = 2 Private Const COMPLEXREGION As Long = 3Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
再用FrameRgn绘制区域边框
再用FrameRgn绘制区域边框就行它们都是Win32 API,有什么不明白的查MSDN就行Call GetWindowRgn(hWnd, hRgn)
Call FrameRgn(hDC, hRgn, hBr, 1, 1)
看里面画红色边框那部分的原理。。
http://img263.photo.163.com/biku/31501462/833571610.jpg
Public Sub FrameWindow(ByVal hWnd As Long, Optional PenWidth As Long = 2)
Dim hDC As Long
Dim hRgn As Long
Dim hPen As Long
Dim hOldPen As Long
Dim hBrush As Long
Dim hOldBrush As Long
Dim OldMixMode As Long
Dim cxFrame As Long
Dim cyFrame As Long
Dim r As RECT
If IsWindow(hWnd) Then
hDC = GetWindowDC(hWnd)
hRgn = CreateRectRgn(0, 0, 0, 0)
hPen = CreatePen(PS_INSIDEFRAME, GetSystemMetrics(SM_CXBORDER) * PenWidth, RGB(0, 0, 0))
hOldPen = SelectObject(hDC, hPen)
hOldBrush = SelectObject(hDC, GetStockObject(NULL_BRUSH))
OldMixMode = SetROP2(hDC, R2_NOT)
If GetWindowRgn(hWnd, hRgn) <> ERRORAPI Then
hBrush = CreateHatchBrush(HS_DIAGCROSS, GetSysColor(CTLCOLOR_STATIC))
Call FrameRgn(hDC, hRgn, hBrush, GetSystemMetrics(SM_CXBORDER) * PenWidth, GetSystemMetrics(SM_CYBORDER) * PenWidth)
Else
cxFrame = GetSystemMetrics(SM_CXFRAME): cyFrame = GetSystemMetrics(SM_CYFRAME)
Call GetWindowRect(hWnd, r)
If IsZoomed(hWnd) Then
Call Rectangle(hDC, cxFrame, cyFrame, GetSystemMetrics(SM_CXSCREEN) + cxFrame, GetSystemMetrics(SM_CYSCREEN) + cyFrame)
Else
Call Rectangle(hDC, 0, 0, r.Right - r.Left, r.Bottom - r.Top)
End If
End If
'Cleanup
Call SelectObject(hDC, hOldPen)
Call SelectObject(hDC, hOldBrush)
Call SetROP2(hDC, OldMixMode)
Call DeleteObject(hPen)
Call DeleteObject(hBrush)
Call DeleteObject(hRgn)
Call ReleaseDC(hWnd, hDC)
End If
End Sub
这里有个
窗体:
Option Explicit
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPointXY Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private m_hWnd As Long
Private m_Picking As Boolean
Private Sub Form_Load()
Picture1.Picture = Picture1.DragIcon
Me.MouseIcon = Picture1.DragIcon
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Me.MousePointer = vbCustom
Set Picture1.Picture = Nothing
m_Picking = True
Call SetCapture(Picture1.hWnd)
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Static pt As POINTAPI
Static hWnd As Long
If m_Picking Then
Call GetCursorPos(pt)
hWnd = WindowFromPointXY(pt.x, pt.y)
If hWnd <> m_hWnd Then
' Erase previous highlight.
Call FrameWindow(m_hWnd)
' Cache new handle, update caption, and highlight.
m_hWnd = hWnd
Me.Caption = Hex(m_hWnd)
Call FrameWindow(m_hWnd)
End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
' have done picking
m_Picking = False
' Erase highlight.
Call FrameWindow(m_hWnd)
Picture1.Picture = Picture1.DragIcon
Me.MousePointer = vbDefault
Call ReleaseCapture
MsgBox Hex(m_hWnd)
End Sub
模块:
Option ExplicitPrivate Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hDC As Long, ByVal nDrawMode As Long) As Long
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Const PS_INSIDEFRAME As Long = 6
Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const SM_CXBORDER As Long = 5
Private Const SM_CYBORDER As Long = 6
Private Const SM_CXFRAME As Long = 32
Private Const SM_CYFRAME As Long = 33
Private Const NULL_BRUSH As Long = 5
Private Const NULL_PEN As Long = 8
Private Const R2_NOT As Long = 6
Private Const HS_DIAGCROSS As Long = 5
Private Const CTLCOLOR_STATIC As Long = 6
Private Const ERRORAPI As Long = 0
Private Const NULLREGION As Long = 1
Private Const SIMPLEREGION As Long = 2
Private Const COMPLEXREGION As Long = 3Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
正在转换成DELPHI。晚上结帖。还是VB的人气好啊!