Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleGive PictureBoxes different border styles (raised, sunken, etc.)
DescriptionThis example shows how to give PictureBoxes different border styles (raised, sunken, etc.) in Visual Basic 6.
KeywordsPictureBox, border style, raised, sunken
CategoriesAPI, Graphics, Controls
 
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
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated