• Home
 · 
• Custom Controls/Forms/Menus
 · 
• Set Border to Form

Set Border to Form

Set Border to Form

API Declarations


X As Long
Y As Long
End Type
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




Rate Set Border to Form

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Dim HiLiteCol As Long
Dim ShadowCol As Long
Dim Steps As Integer
Dim Steps1 As Integer
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
     
Me.BackColor = &HC1E8FD
ShadowCol = &HDEF3FE
HiLiteCol = &HD6595
     
' switch to pixel scalemode
oldForeColor = Me.ForeColor
oldScaleMode = Me.ScaleMode
Me.ScaleMode = vbPixels

'Set the form width, height & DC
With Me
   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 = Me.BackColor
R_Inner = (InnerCol And &HFF&)
G_Inner = (InnerCol And &HFF00&) / &H100&
B_Inner = (InnerCol And &HFF0000) / &H10000
    
'set the increments
Steps1 = 10
R_HiLiteIncr = (R_HiLite - R_Inner) / Steps1
G_HiLiteIncr = (G_HiLite - G_Inner) / Steps1
B_HiLiteIncr = (B_HiLite - B_Inner) / Steps1
R_ShadowIncr = (R_Shadow - R_Inner) / Steps1
G_ShadowIncr = (G_Shadow - G_Inner) / Steps1
B_ShadowIncr = (B_Shadow - B_Inner) / Steps1
'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 Me
    For i = 0 To 20
        LongVal = (Int(B_HiLiteCur) * 65536) + (Int(G_HiLiteCur) * 256) + _
            Int(R_HiLiteCur)
    
        .ForeColor = LongVal
        MoveToEx DC, 0, i, LP      'top
        LineTo DC, WD - 0, i

        LongVal = (Int(B_ShadowCur) * 65536) + (Int(G_ShadowCur) * 256) + _
            Int(R_ShadowCur)
        .ForeColor = LongVal
        If Not UCase(Me.Caption) = UCase("Login Information") Then
            If i < 10 Then
                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
            ElseIf i > 11 Then
                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 If
        End If
    Next
    Steps = 8
    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
   
    R_HiLiteCur = R_HiLite
    G_HiLiteCur = G_HiLite
    B_HiLiteCur = B_HiLite
    R_ShadowCur = R_Shadow
    G_ShadowCur = G_Shadow
    B_ShadowCur = B_Shadow
    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
        If Not UCase(Me.Caption) = UCase("Login Information") Then
            MoveToEx DC, i, HT - i, LP 'left
            If i <= 1 Then LineTo DC, i, i Else LineTo DC, i, i
            MoveToEx DC, (9 - i) + Me.ScaleWidth - 10, HT - i, LP 'left
            LineTo DC, (9 - i) + Me.ScaleWidth - 10, i
            MoveToEx DC, i, (10 - i) + Me.ScaleHeight - 11, LP  'top
            LineTo DC, WD - i, (10 - i) + Me.ScaleHeight - 11

        Else
            MoveToEx DC, i, HT - i, LP      'left
            LineTo DC, i, i
            MoveToEx DC, i, i, LP        'top
            LineTo DC, WD - i, i
            MoveToEx DC, (10 - i) + Me.ScaleWidth - 11, HT - i, LP 'left
            LineTo DC, (9 - i) + Me.ScaleWidth - 10, i - 1
            MoveToEx DC, i, (10 - i) + Me.ScaleHeight - 11, LP  'top
            LineTo DC, WD - i, (10 - i) + Me.ScaleHeight - 11
        End If
        '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

        '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
End With

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

End Sub