Thanks to Dipak Auddy.
The program subclasses the PictureBox and watches for its WM_NCPAINT message. When it catches this message, it calls the DrawEdge API function to draw the control's edge in one of the styles: normal, none, sunken, sunken outer, raised, raised inner, bump, or etched.
Subroutine ApplyBorderStyle subclasses the PictureBox and saves the desired border style. Subroutine RestoreBorderStyle unsubclasses the PictureBox.
|
Public Sub ApplyBorderStyle(ByVal lngHWnd As Long, ByVal _
eBorderStyle As sedBorderStyle)
Dim lRet As Long
'Check whether the window was already subclassed
'and get the original windowproc...
lRet = GetProp(lngHWnd, SED_OLDPROC)
If lRet <> 0 Then
'Unsubclass the window...
SetWindowLong lngHWnd, GWL_WNDPROC, lRet
Else 'NOT LRET...
'Store the window style (only the first time we
' subclass the window)...
SetProp lngHWnd, SED_OLDGWLSTYLE, _
GetWindowLong(lngHWnd, GWL_STYLE)
SetProp lngHWnd, SED_OLDGWLEXSTYLE, _
GetWindowLong(lngHWnd, GWL_EXSTYLE)
End If
'Change to the window border that best suits our
' drwaing requirements...
pSetBorder lngHWnd, eBorderStyle
'Subclass the window...
lRet = SetWindowLong(lngHWnd, GWL_WNDPROC, AddressOf _
pWindowProc)
'Store the original windowproc and the new border
' style...
SetProp lngHWnd, SED_OLDPROC, lRet
SetProp lngHWnd, SED_BORDERS, CLng(eBorderStyle)
'Refresh the window (this forces Windows to send a
' WM_NCPAINT message)...
SetWindowPos lngHWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or _
SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or _
SWP_FRAMECHANGED
End Sub
Public Sub RestoreBorderStyle(ByVal lngHWnd As Long)
Dim lRet As Long
'Get the original windowproc for this window...
lRet = GetProp(lngHWnd, SED_OLDPROC)
If lRet <> 0 Then
'Unsubclass the window by assigning the original
' windowproc...
lRet = SetWindowLong(lngHWnd, GWL_WNDPROC, lRet)
'Restore the original window styles...
SetWindowLong lngHWnd, GWL_STYLE, GetProp(lngHWnd, _
SED_OLDGWLSTYLE)
SetWindowLong lngHWnd, GWL_EXSTYLE, _
GetProp(lngHWnd, SED_OLDGWLEXSTYLE)
'Refresh the window (sends message WM_NCPAINT)...
SetWindowPos lngHWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or _
SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER _
Or SWP_FRAMECHANGED
'Remove all stored information for this window...
RemoveProp lngHWnd, SED_OLDPROC
RemoveProp lngHWnd, SED_OLDGWLSTYLE
RemoveProp lngHWnd, SED_OLDGWLEXSTYLE
RemoveProp lngHWnd, SED_BORDERS
End If
End Sub
Private Sub pWindowProc(ByVal lngHWnd As Long, ByVal uMsg _
As Long, ByVal wParam As Long, ByVal lParam As Long)
Select Case uMsg 'Select the message uMsg and only
' modify WM_NCPAINT...
Case WM_NCPAINT 'Message sent to a window when its
' non-client area needs to be re-drawn ...
'Call our own drawing function...
pDrawBorder lngHWnd, wParam, GetProp(lngHWnd, _
SED_BORDERS)
Case Else
'All other messages should be sent to the original
' windowproc...
CallWindowProc GetProp(lngHWnd, SED_OLDPROC), _
lngHWnd, uMsg, wParam, lParam
End Select
End Sub
Private Sub pDrawBorder(ByVal lngHWnd As Long, ByVal wParam _
As Long, ByVal lBorderType As sedBorderStyle)
Dim lMode As Long
Dim hDC As Long
Dim Rec As RECT
'There's no drawing needed when there's no border
' assigned...
If lBorderType = sedNone Then
Exit Sub
End If '<:-) Structure Expanded.
'Get a device context for this window handle...
hDC = GetWindowDC(lngHWnd)
'Get the RECT that contains the window...
Call GetWindowRect(lngHWnd, Rec)
With Rec
.Right = .Right - .Left
.Bottom = .Bottom - .Top
.Left = 0
.Top = 0
'Choose the drawing flags based on the selected
' border style...
End With 'Rec
lMode = 0
Select Case lBorderType
Case sedRaised
lMode = BDR_RAISED
Case sedRaisedInner
lMode = BDR_RAISEDINNER
Case sedSunken
lMode = BDR_SUNKEN
Case sedSunkenOuter
lMode = BDR_SUNKENOUTER
Case sedEtched
lMode = BDR_SUNKENOUTER Or BDR_RAISEDINNER
Case sedBump
lMode = BDR_SUNKENINNER Or BDR_RAISEDOUTER
End Select
'Draw the window border by using the API DrawEdge...
Call DrawEdge(hDC, Rec, lMode, BF_RECT)
'Release the device context...
Call ReleaseDC(lngHWnd, hDC)
End Sub
|