dcsimg
Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


Tip of the Day
Language: VB5,VB6
Expertise: Intermediate
Jun 30, 2001

WEBINAR:

On-Demand

Building the Right Environment to Support AI, Machine Learning and Deep Learning


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
Marco Bellinaso
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date