by SethuMathavan.P (1 Submission)
Category: Custom Controls/Forms/Menus
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Tue 27th November 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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