VB icon

Advanced Bevel (Paintshop-like filter)

Email
Submitted on: 2/7/2015 4:45:00 PM
By: KRYO_11 (from psc cd)  
Level: Intermediate
User Rating: By 2 Users
Compatibility: VB 5.0, VB 6.0
Views: 949
 
     This is an advanced bevel that has the look of paintshop's bevel filter. Very smooth, see screenshot. Please vote/leave comments.

 

Windows API/Global Declarations:

Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
'**************************************
'Windows API/Global Declarations for :Advanced Bevel (Paintshop-like filter)
'**************************************
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, Col As Long) As Long
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Advanced Bevel (Paintshop-like filter)
' Description:This is an advanced bevel that has the look of paintshop's bevel filter. Very smooth, see screenshot. Please vote/leave comments.
' By: KRYO_11 (from psc cd)
'**************************************

Public Sub Bevel(ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Thickness As Integer, Optional OuterBevel As Boolean = True)
Dim dCol As Long
Dim i As Long, j As Long, R As Long
Dim vAdj As Integer, lFactor As Integer
Dim Step As Single
Dim OffSet As Integer
'Ensure thickness is between 1 and 100
Thickness = SetBound(Thickness, 1, 100)
'if it is an inner bevel the factor and step need to be reversed
If OuterBevel Then
lFactor = 125
Step = 125 / Thickness
Else
lFactor = -125
Step = -(125 / Thickness)
End If
'this draws the horizontal shadow/highlight from left to right
For i = X1 To X2
vAdj = 0
For j = 1 To Thickness
'this IF statement ensure the bevels do not overlap
If i - X1 >= vAdj And i - X1 <= X2 - vAdj Then
'get the pixel color for the top and lighten/darken it
dCol = AdjustBrightness(GetPixel(hDC, i, Y1 + j - 1), lFactor - (vAdj * Step))
SetPixel hDC, i, Y1 + j - 1, dCol
'get the pixel color for the bottom and lighten/darken it
dCol = AdjustBrightness(GetPixel(hDC, i, Y2 - j), -lFactor + (vAdj * Step))
SetPixel hDC, i, Y2 - j, dCol
End If
vAdj = vAdj + 1
Next j
Next i
'this draws the verticle shadow/highlight from top to bottom
For i = Y1 To Y2
vAdj = 0
For j = 1 To Thickness
'this IF statement ensure the bevels do not overlap
If i - Y1 >= vAdj And i - Y1 <= Y2 - vAdj Then
'get the pixel color for the left and lighten/darken it
dCol = AdjustBrightness(GetPixel(hDC, X1 + j - 1, i), lFactor - (vAdj * Step))
SetPixel hDC, X1 + j - 1, i, dCol
'get the pixel color for the right and lighten/darken it
dCol = AdjustBrightness(GetPixel(hDC, X2 - j, i), -lFactor + (vAdj * Step))
SetPixel hDC, X2 - j, i, dCol
End If
vAdj = vAdj + 1
Next j
Next i
End Sub
Private Function SetBound(ByVal Num As Single, ByVal MinNum As Single, ByVal MaxNum As Single) As Single
'this is to support the above functions
'makes sure a number is between certain values
If Num < MinNum Then
SetBound = MinNum
ElseIf Num > MaxNum Then
SetBound = MaxNum
Else
SetBound = Num
End If
End Function
Public Function AdjustBrightness(ByVal Color As Long, ByVal Amount As Single) As Long
On Error Resume Next
'lightens/darken a color
Dim R(1) As Integer, G(1) As Integer, B(1) As Integer
GetRGB R(0), G(0), B(0), Color
R(1) = SetBound(R(0) + Amount, 0, 255)
G(1) = SetBound(G(0) + Amount, 0, 255)
B(1) = SetBound(B(0) + Amount, 0, 255)
AdjustBrightness = RGB(R(1), G(1), B(1))
End Function
Public Sub GetRGB(R As Integer, G As Integer, B As Integer, ByVal Color As Long)
Dim TempValue As Long
TranslateColor Color, 0, TempValue
'get the red, green, and blue values
If Color Then
R = Color And &HFF&
G = Color \ 256 And &HFF
B = Color \ 65536
Else
R = 0
G = 0
B = 0
End If
End Sub


Other 19 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.