vbAccelerator - Contents of code file: cBrightnessAndContrast.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cBrightnessContrast"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr()
 As Any) As Long

Private m_lBrightness As Long ' -255 all black -> 0 normal -> 255 all white
Private m_fContrast As Double ' 1/n less contrast -> 1 normal -> n more contrast
Public Property Get Brightness() As Long
   Brightness = m_lBrightness
End Property
Public Property Let Brightness(ByVal lBrightness As Long)
   m_lBrightness = lBrightness
End Property
Public Property Get Contrast() As Double
   Contrast = m_fContrast
End Property
Public Property Let Contrast(ByVal fContrast As Double)
   m_fContrast = fContrast
End Property

Public Sub process( _
      cSrc As cDIBSection, _
      cDst As cDIBSection _
   )
      Dim bDib() As Byte
      Dim bDibDst() As Byte
      Dim tSA As SAFEARRAY2D
      Dim tSADst As SAFEARRAY2D
    
      ' Get the bits in the from DIB section:
      With tSA
          .cbElements = 1
          .cDims = 2
          .Bounds(0).lLbound = 0
          .Bounds(0).cElements = cSrc.Height
          .Bounds(1).lLbound = 0
          .Bounds(1).cElements = cSrc.BytesPerScanLine
          .pvData = cSrc.DIBSectionBitsPtr
      End With
      CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4
   
      ' Get the bits in the to DIB section:
      With tSADst
          .cbElements = 1
          .cDims = 2
          .Bounds(0).lLbound = 0
          .Bounds(0).cElements = cDst.Height
          .Bounds(1).lLbound = 0
          .Bounds(1).cElements = cDst.BytesPerScanLine()
          .pvData = cDst.DIBSectionBitsPtr
      End With
      CopyMemory ByVal VarPtrArray(bDibDst()), VarPtr(tSADst), 4
      
      Dim x As Long
      Dim y As Long
      Dim xEnd As Long
      Dim yEnd As Long
      Dim fR As Double
      Dim fB As Double
      Dim fG As Double
      
      xEnd = cSrc.BytesPerScanLine() - 3
      yEnd = cSrc.Height - 1
      
      For x = 0 To xEnd Step 3
         For y = 0 To yEnd
         
            ' Contrast
            fR = ((bDib(x + 2, y) - 128#) * m_fContrast) + 128
            fG = ((bDib(x + 1, y) - 128#) * m_fContrast) + 128
            fB = ((bDib(x, y) - 128#) * m_fContrast) + 128
            
            ' Brightness:
            fR = fR + m_lBrightness
            fG = fG + m_lBrightness
            fB = fB + m_lBrightness
            
            ' Clamp results:
            If (fR > 255) Then fR = 255
            If (fR < 0) Then fR = 0
            If (fG > 255) Then fG = 255
            If (fG < 0) Then fG = 0
            If (fB > 255) Then fB = 255
            If (fB < 0) Then fB = 0
            
            ' Apply to DIB
            bDibDst(x + 2, y) = fR
            bDibDst(x + 1, y) = fG
            bDibDst(x, y) = fB
         Next y
      Next x
      
      CopyMemory ByVal VarPtrArray(bDibDst), 0&, 4
      CopyMemory ByVal VarPtrArray(bDib), 0&, 4
End Sub