VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDMA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DMA function by Cyborg (contact at vbforums.com)
' Thanks to Electroman for his DMA exaples.
'
' Example on how to use the Brightness function of this class:
' Dim DMA as clsDMA
' Set DMA = New clsDMA
' DMA.Init MyPicturebox
' DMA.Brightness 0.5
' MyPicturebox.Refresh
' DMA.Destruct
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function VarPtr Lib "msvbvm50.dll" (Ptr As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () 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 Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
    
Dim bmp As BITMAP
Dim SA As SAFEARRAY2D
Dim Pic() As Byte

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub Init(ByRef picDisp As PictureBox)
    'TODO: remove these 3 lines and do it a better way
    SavePicture picDisp.Image, App.Path & "\temp.bmp"
    picDisp.Picture = LoadPicture(App.Path & "\temp.bmp")
    Kill App.Path & "\temp.bmp"

    GetObjectAPI picDisp.Picture, Len(bmp), bmp
    
    With SA
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = bmp.bmHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = bmp.bmWidthBytes
        .pvData = bmp.bmBits 'This is a pointer to where the BMP is in memory
    End With
    
    CopyMemory ByVal VarPtrArray(Pic), VarPtr(SA), 4
End Sub

Public Sub Destruct()
    CopyMemory ByVal VarPtrArray(Pic), 0&, 4
End Sub




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'PUBLIC MANIPULATIVE FUNCTIONS (change entire image in sertain ways)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'TODO: Add Gamma
'TODO: Add Contrast
'TODO: Add Hue-Saturation-Value
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub Brightness(Value As Double)
    Dim X As Long
    Dim Y As Long
    
    If Value = 1 Then Exit Sub
    
    For X = LBound(Pic, 1) To UBound(Pic, 1)
        For Y = LBound(Pic, 2) To UBound(Pic, 2)
            Pic(X, Y) = BoundValue(Pic(X, Y) + (Value - 1) * 255)
        Next
    Next
End Sub




''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'PUBLIC SET/GET FUNCTIONS (manipulates one pixel at a time)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'TODO: Add GetPixel
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub SetPixel(X As Long, Y As Long, R As Byte, G As Byte, B As Byte)
    If X < 0 Then Exit Sub
    If X >= bmp.bmWidth Then Exit Sub
    If Y < 0 Then Exit Sub
    If Y >= bmp.bmHeight Then Exit Sub
    
    Pic(X * 3, bmp.bmHeight - Y - 1) = R
    Pic(X * 3 + 1, bmp.bmHeight - Y - 1) = G
    Pic(X * 3 + 2, bmp.bmHeight - Y - 1) = B
End Sub

Public Sub BlendPixel(X As Long, Y As Long, R As Byte, G As Byte, B As Byte, A As Double)
    If X < 0 Then Exit Sub
    If X >= bmp.bmWidth Then Exit Sub
    If Y < 0 Then Exit Sub
    If Y >= bmp.bmHeight Then Exit Sub
    
    Pic(X * 3, bmp.bmHeight - Y - 1) = Pic(X * 3, bmp.bmHeight - Y - 1) * A + R * (1 - A)
    Pic(X * 3 + 1, bmp.bmHeight - Y - 1) = Pic(X * 3 + 1, bmp.bmHeight - Y - 1) * A + G * (1 - A)
    Pic(X * 3 + 2, bmp.bmHeight - Y - 1) = Pic(X * 3 + 2, bmp.bmHeight - Y - 1) * A + B * (1 - A)
End Sub

Public Sub BlendPixelExt(X As Long, Y As Long, R As Byte, G As Byte, B As Byte, A As Double, Opacity As Double)
    If X < 0 Then Exit Sub
    If X >= bmp.bmWidth Then Exit Sub
    If Y < 0 Then Exit Sub
    If Y >= bmp.bmHeight Then Exit Sub
    
    Pic(X * 3, bmp.bmHeight - Y - 1) = Pic(X * 3, bmp.bmHeight - Y - 1) * (1 - Opacity) + (Pic(X * 3, bmp.bmHeight - Y - 1) * A + R * (1 - A)) * Opacity
    Pic(X * 3 + 1, bmp.bmHeight - Y - 1) = Pic(X * 3 + 1, bmp.bmHeight - Y - 1) * (1 - Opacity) + (Pic(X * 3 + 1, bmp.bmHeight - Y - 1) * A + G * (1 - A)) * Opacity
    Pic(X * 3 + 2, bmp.bmHeight - Y - 1) = Pic(X * 3 + 2, bmp.bmHeight - Y - 1) * (1 - Opacity) + (Pic(X * 3 + 2, bmp.bmHeight - Y - 1) * A + B * (1 - A)) * Opacity
End Sub





''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'PUBLIC REGIONAL FUNCTIONS (acting over several pixels)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'TODO: CopyBlock1D
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub Cls(Optional R As Byte = 0, Optional G As Byte = 0, Optional B As Byte = 0)
    Dim X As Long
    Dim Y As Long
    
    For X = LBound(Pic, 1) To UBound(Pic, 1) - 2 Step 3
        Pic(X, 0) = B
        Pic(X + 1, 0) = G
        Pic(X + 2, 0) = R
    Next
    
    For Y = LBound(Pic, 2) To UBound(Pic, 2)
        CopyMemory Pic(0, Y), Pic(0, 0), UBound(Pic, 1) - LBound(Pic, 1)
    Next
End Sub

Public Sub CopyBlock2D(Data() As Byte, srcW As Long, srcH As Long, ByVal X As Long, ByVal Y As Long)
    Dim StartX As Long
    Dim EndX As Long
    Dim StartY As Long
    Dim EndY As Long
    
    Dim NewY As Long
    
    If X + srcW - 1 < 0 Then Exit Sub
    If Y + srcH - 1 < 0 Then Exit Sub
    If X >= bmp.bmWidth Then Exit Sub
    If Y >= bmp.bmHeight Then Exit Sub
    
    StartX = 0
    EndX = srcW
    StartY = 0
    EndY = srcH - 1
    
    If X < 0 Then StartX = -X
    If Y < 0 Then StartY = -Y
    If X + srcW >= bmp.bmWidth Then EndX = bmp.bmWidth - X
    If Y + srcH - 1 >= bmp.bmHeight Then EndY = bmp.bmHeight - Y - 1
    
    
    For NewY = StartY To EndY
        CopyMemory Pic((X + StartX) * 3, bmp.bmHeight - (NewY + Y) - 1), Data(StartX * 3, NewY), 3 * (EndX - StartX)
    Next
End Sub

Public Sub CopyBlock3D(Data() As Byte, Frame As Long, srcW As Long, srcH As Long, X As Long, Y As Long)
    Dim StartX As Long
    Dim EndX As Long
    Dim StartY As Long
    Dim EndY As Long
    
    Dim NewY As Long
    
    If X + srcW - 1 < 0 Then Exit Sub
    If Y + srcH - 1 < 0 Then Exit Sub
    If X >= bmp.bmWidth Then Exit Sub
    If Y >= bmp.bmHeight Then Exit Sub
    
    StartX = 0
    EndX = srcW
    StartY = 0
    EndY = srcH - 1
    
    If X < 0 Then StartX = -X
    If Y < 0 Then StartY = -Y
    If X + srcW >= bmp.bmWidth Then EndX = bmp.bmWidth - X
    If Y + srcH - 1 >= bmp.bmHeight Then EndY = bmp.bmHeight - Y - 1
    
    
    For NewY = StartY To EndY
        CopyMemory Pic((X + StartX) * 3, bmp.bmHeight - (NewY + Y) - 1), Data(StartX * 3, NewY, Frame), 3 * (EndX - StartX)
    Next
End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'PRIVATE FUNCTIONS (used within the public functions)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Private Function BoundValue(Value As Long) As Byte
    If Value < 0 Then
        BoundValue = 0
    ElseIf Value > 255 Then
        BoundValue = 255
    Else
        BoundValue = Value
    End If
End Function