Binaryworld - DrawBorder - Draw a raised/bump/etched/sunken border ... [ VB -> Forms & Controls ]

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