Code:
setBorderColor Text1.hWnd, vbBlue
setBorderColor Picture1.hWnd, vbRedCode:
Private Type RECTW
Left As Long
Top As Long
Right As Long
Bottom As Long
Width As Long
Height As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 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 Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Const WM_DESTROY As Long = &H2
Private Const WM_PAINT As Long = &HF
Private Const WM_NCPAINT As Integer = &H85
Private Const GWL_WNDPROC = (-4)
Private Color As Long
Public Sub setBorderColor(hWnd As Long, Color_ As Long)
Color = Color_
If GetProp(hWnd, "OrigProcAddr") = 0 Then
SetProp hWnd, "OrigProcAddr", SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End If
End Sub
Public Sub UnHook(hWnd As Long)
Dim OrigProc As Long
OrigProc = GetProp(hWnd, "OrigProcAddr")
If Not OrigProc = 0 Then
SetWindowLong hWnd, GWL_WNDPROC, OrigProc
OrigProc = SetWindowLong(hWnd, GWL_WNDPROC, OrigProc)
RemoveProp hWnd, "OrigProcAddr"
End If
End Sub
Private Function OnPaint(OrigProc As Long, hWnd As Long, uMsg As Long, wParam As Long, lParam As Long) As Long
Dim m_hDC As Long
Dim m_wRect As RECTW
OnPaint = CallWindowProc(OrigProc, hWnd, uMsg, wParam, lParam)
Call pGetWindowRectW(hWnd, m_wRect)
m_hDC = GetWindowDC(hWnd)
Call pFrameRect(m_hDC, 0, 0, m_wRect.Width, m_wRect.Height)
Call ReleaseDC(hWnd, m_hDC)
End Function
Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim OrigProc As Long
Dim ClassName As String
If hWnd = 0 Then Exit Function
OrigProc = GetProp(hWnd, "OrigProcAddr")
If Not OrigProc = 0 Then
If uMsg = WM_DESTROY Then
SetWindowLong hWnd, GWL_WNDPROC, OrigProc
WindowProc = CallWindowProc(OrigProc, hWnd, uMsg, wParam, lParam)
RemoveProp hWnd, "OrigProcAddr"
Else
If uMsg = WM_PAINT Or WM_NCPAINT Then
WindowProc = OnPaint(OrigProc, hWnd, uMsg, wParam, lParam)
Else
WindowProc = CallWindowProc(OrigProc, hWnd, uMsg, wParam, lParam)
End If
End If
Else
WindowProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
End If
End Function
Private Function pGetWindowRectW(ByVal hWnd As Long, lpRectW As RECTW) As Long
Dim TmpRect As RECT
Dim Rtn As Long
Rtn = GetWindowRect(hWnd, TmpRect)
With lpRectW
.Left = TmpRect.Left
.Top = TmpRect.Top
.Right = TmpRect.Right
.Bottom = TmpRect.Bottom
.Width = TmpRect.Right - TmpRect.Left
.Height = TmpRect.Bottom - TmpRect.Top
End With
pGetWindowRectW = Rtn
End Function
Private Function pFrameRect(ByVal hDC As Long, ByVal x As Long, y As Long, ByVal Width As Long, ByVal Height As Long) As Long
Dim TmpRect As RECT
Dim m_hBrush As Long
With TmpRect
.Left = x
.Top = y
.Right = x + Width
.Bottom = y + Height
End With
m_hBrush = CreateSolidBrush(Color)
pFrameRect = FrameRect(hDC, TmpRect, m_hBrush)
DeleteObject m_hBrush
End Function