DrawBorder - Draw a raised/bump/etched/sunken border

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Enum mbBorderTypeConstants
    mbRaised = 0
    mbSunken = 1
    mbEtched = 2
    mbBump = 3
End Enum

'draw a raised/bump/etched/sunken border at given coordinates

Private Sub DrawBorder(Target As Object, rcBorder As RECT, _
    Optional ByVal BorderType As mbBorderTypeConstants = mbRaised, _
    Optional ByVal BorderWidth As Long = 1, Optional ByVal HighLightColor As _
    OLE_COLOR = vb3DHighlight, Optional ByVal ShadowColor As OLE_COLOR = _
    vb3DShadow)
    
    Dim HOffset As Long, VOffset As Long
    Dim iOldScaleMode As Integer, iOldDrawWidth As Integer
    Dim TPPX As Long, TPPY As Long, i As Integer
    Dim rc As RECT
    
    On Error Resume Next
    'save the current target's ScaleMode and DrawWidth
    iOldScaleMode = Target.ScaleMode
    iOldDrawWidth = Target.DrawWidth
    'save the values to convert from pixels to twips
    TPPX = Screen.TwipsPerPixelX
    TPPY = Screen.TwipsPerPixelY
    'convert rect coords from pixels to twips
    rc.Left = rcBorder.Left * TPPX
    rc.Right = rcBorder.Right * TPPX
    rc.Top = rcBorder.Top * TPPY
    rc.Bottom = rcBorder.Bottom * TPPY
    'change the target's ScaleMode (vbTwips) and DrawWidth
    Target.ScaleMode = vbTwips
    Target.DrawWidth = BorderWidth

    Select Case BorderType
        Case Is = mbRaised, mbSunken
            Target.DrawWidth = 1
            For i = 1 To BorderWidth
                Target.Line (rc.Left + HOffset, rc.Top + VOffset)-(rc.Left + _
                    HOffset, rc.Bottom - VOffset), IIf(BorderType = mbRaised, _
                    HighLightColor, ShadowColor)
                Target.Line (rc.Left + HOffset, rc.Top + VOffset)-(rc.Right - _
                    HOffset, rc.Top + VOffset), IIf(BorderType = mbRaised, _
                    HighLightColor, ShadowColor)
                Target.Line (rc.Right - HOffset - TPPX, _
                    rc.Top + VOffset)-(rc.Right - HOffset - TPPX, _
                    rc.Bottom - VOffset), IIf(BorderType = mbRaised, _
                    ShadowColor, HighLightColor)
                Target.Line (rc.Left + HOffset, rc.Bottom - VOffset - TPPY)- _
                    (rc.Right - HOffset, rc.Bottom - VOffset - TPPY), _
                    IIf(BorderType = mbRaised, ShadowColor, HighLightColor)
                HOffset = HOffset + TPPX
                VOffset = VOffset + TPPY
            Next
            
        Case Is = mbEtched, mbBump
            HOffset = -Int(-(BorderWidth / 2)) * TPPX
            VOffset = -Int(-(BorderWidth / 2)) * TPPY
            If BorderWidth = 1 Then
                TPPX = 0
                TPPY = 0
            End If
            Target.Line (rc.Left + HOffset + TPPX, rc.Top + VOffset + TPPY)- _
                (rc.Right - HOffset, rc.Bottom - VOffset), _
                IIf(BorderType = mbEtched, HighLightColor, ShadowColor), B
            Target.Line (rc.Left + TPPX, rc.Top + TPPY)-(rc.Right - 2 * HOffset, _
                rc.Bottom - 2 * VOffset), IIf(BorderType = mbEtched, _
                ShadowColor, HighLightColor), B
    End Select
    'restore the old values for the target's ScaleMode and ScaleWidth properties
    Target.ScaleMode = iOldScaleMode
    Target.DrawWidth = iOldDrawWidth
End Sub


'sample
Private Sub Form_Load()
    Dim rc As RECT
    rc.Left = 10
    rc.Top = 10
    rc.Bottom = 110
    rc.Right = 110
    DrawBorder Me, rc, mbRaised, 2
    rc.Left = 20
    rc.Top = 20
    rc.Bottom = 100
    rc.Right = 100
    DrawBorder Me, rc, mbSunken, 2
    
    rc.Left = 150
    rc.Top = 10
    rc.Bottom = 110
    rc.Right = 250
    DrawBorder Me, rc, mbEtched, 2
    rc.Left = 160
    rc.Top = 20
    rc.Bottom = 100
    rc.Right = 240
    DrawBorder Me, rc, mbBump, 2
End Sub