Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Intermediate
Mar 18, 2000



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) + _
            '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) + _
            '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
    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.



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