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: VB4/32,VB5,VB6
Expertise: Intermediate
Mar 18, 2000

WEBINAR:

On-Demand

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


DrawHighliteGradientFrame - Draw a form with raised/sunken gradient borders

Private Type POINTAPI
    x As Long
    Y As Long
End Type

Private Declare Function SetPixel& Lib "gdi32" (ByVal hDC As Long, _
    ByVal x As Long, ByVal Y As Long, ByVal crColor As Long)
Private Declare Function LineTo& Lib "gdi32" (ByVal hDC As Long, _
    ByVal x As Long, ByVal Y As Long)
Private Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, _
    ByVal x As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long

' Create a form with a 3D gradient frame
'
' Pass this a borderless form
' You get better results with AutoRedraw set to TRUE
' and with HiLiteCol and ShadowCol "close" to the
' form's BackColor
'
' It draws a series of lines around the form
' starting on the outside and moving one pixel inward with each line
' the number of lines is determined by the "Steps" value that is passed.
' The Left and Top use the "HiliteCol" value
' the Right and Bottom use the "ShadowCol" value.
' Swap them to get a sunken effect

' Call this routine from within Form_Load, as in:
'    Sub Form_Load()
'        Const MyBackgroundColor = 16119262
'        Const MyShadowColor = 14474381
'        Const MyHiLiteColor = 15329769
'        Me.BackColor = MyBackgroundColor
'        DrawHighliteGradientFrame Me, MyHiLiteColor, MyShadowColor, 7
'    End Sub


Sub DrawHighliteGradientFrame(FormIn As Form, ByVal HiLiteCol As Long, _
    ByVal ShadowCol As Long, ByVal Steps As Integer)
    ' exit if the form is minimized
    If FormIn.WindowState = vbMinimized Then Exit Sub
       
    Dim InnerCol As Long
    Dim R_Inner As Long, G_Inner As Long, B_Inner As Long
    Dim R_HiLite As Long, G_HiLite As Long, B_HiLite As Long 
    Dim R_Shadow As Long, G_Shadow As Long, B_Shadow As Long
    Dim R_HiLiteIncr As Single, G_HiLiteIncr As Single, B_HiLiteIncr As Single,
    Dim R_HiLiteCur As Single, G_HiLiteCur As Single, B_HiLiteCur As Single
    Dim R_ShadowIncr As Single, G_ShadowIncr As Single, B_ShadowIncr As Single,
    Dim R_ShadowCur As Single, G_ShadowCur As Single, B_ShadowCur As Single
    Dim sTemp As String, i As Integer, WD  As Long, HT As Long, DC As Long
    Dim pos As Integer, LP As POINTAPI, LongVal As Long
    Dim oldScaleMode As Integer, oldForeColor As Long
     
    ' switch to pixel scalemode
    oldForeColor = FormIn.ForeColor
    oldScaleMode = FormIn.ScaleMode
    FormIn.ScaleMode = vbPixels
    
    'Set the form width, height & DC
    With FormIn
       WD = .ScaleWidth - 1
       HT = .ScaleHeight - 1
       DC = .hDC
    End With
    
    'convert the hilite color from long to RGB
    R_HiLite = (HiLiteCol And &HFF&)
    G_HiLite = (HiLiteCol And &HFF00&) / &H100&
    B_HiLite = (HiLiteCol And &HFF0000) / &H10000
    
    'convert the shadow color from long to RGB
    R_Shadow = (ShadowCol And &HFF&)
    G_Shadow = (ShadowCol And &HFF00&) / &H100&
    B_Shadow = (ShadowCol And &HFF0000) / &H10000
    
    'convert the inner color from long to RGB
    InnerCol = FormIn.BackColor
    R_Inner = (InnerCol And &HFF&)
    G_Inner = (InnerCol And &HFF00&) / &H100&
    B_Inner = (InnerCol And &HFF0000) / &H10000
        
    'set the increments
    R_HiLiteIncr = (R_HiLite - R_Inner) / Steps
    G_HiLiteIncr = (G_HiLite - G_Inner) / Steps
    B_HiLiteIncr = (B_HiLite - B_Inner) / Steps
    R_ShadowIncr = (R_Shadow - R_Inner) / Steps
    G_ShadowIncr = (G_Shadow - G_Inner) / Steps
    B_ShadowIncr = (B_Shadow - B_Inner) / Steps
    
    'initialize the current colors
    R_HiLiteCur = R_HiLite
    G_HiLiteCur = G_HiLite
    B_HiLiteCur = B_HiLite
    R_ShadowCur = R_Shadow
    G_ShadowCur = G_Shadow
    B_ShadowCur = B_Shadow
    
    With FormIn
        For i = 0 To Steps - 1
            'draw clockwise from bottom / left
            
            'Use hilite color
            'Round the RGB vals  to integers and convert to a long color value
            LongVal = (Int(B_HiLiteCur) * 65536) + (Int(G_HiLiteCur) * 256) + _
                Int(R_HiLiteCur)
            
            'set the drawing color
            .ForeColor = LongVal
            
            'Draw the left and top
            MoveToEx DC, i, HT - i, LP        'left
            LineTo DC, i, i
            MoveToEx DC, i, i, LP             'top
            LineTo DC, WD - i, i
            
            'Use shadow color
            'Round the RGB vals  to integers and convert to a long color value
            LongVal = (Int(B_ShadowCur) * 65536) + (Int(G_ShadowCur) * 256) + _
                Int(R_ShadowCur)
            
            'set the drawing color
            .ForeColor = LongVal
            
            'Draw the right and bottom
            MoveToEx DC, WD - i, i, LP       'right
            LineTo DC, WD - i, HT - i
            MoveToEx DC, WD - i, HT - i, LP  'bottom
            LineTo DC, i, HT - i
            
            'increment the colors
            R_HiLiteCur = R_HiLiteCur - R_HiLiteIncr
            G_HiLiteCur = G_HiLiteCur - G_HiLiteIncr
            B_HiLiteCur = B_HiLiteCur - B_HiLiteIncr
            R_ShadowCur = R_ShadowCur - R_ShadowIncr
            G_ShadowCur = G_ShadowCur - G_ShadowIncr
            B_ShadowCur = B_ShadowCur - B_ShadowIncr
        Next
   
        .Refresh
    End With

    ' restore original values
    FormIn.ForeColor = oldForeColor
    FormIn.ScaleMode = oldScaleMode

End Sub

Rudie Ashman
 
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