Search Tools Links Login

Advanced Bevel (Paintshop-like filter)


This is an advanced bevel that has the look of paintshop's bevel filter. Very smooth, see screenshot. Please vote/leave comments.

Original Author: KRYO_11

API Declarations

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

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

About this post

Posted: 2003-06-01
By: ArchiveBot
Viewed: 95 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.