Attribute VB_Name = "PictureUtilities"
Public Declare Function FloodFill Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long


Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long

Private Type RECT
        Left As Single
        Top As Single
        Right As Single
        Bottom As Single
End Type


Public Enum MCOLORS
    Red = &O1
    Blue = &O2
    Green = &O3
End Enum

'Private Type RECT
'        Left As Long
'        Top As Long
'        Right As Long
'        Bottom As Long
'End Type

Private Const DT_LEFT = &H0
Private Const DT_CALCRECT = &H400
Private Const DT_CENTER = &H1
Private Const DT_BOTTOM = &H8
Private Const DT_RIGHT = &H2
Private Const DT_SINGLELINE = &H20
Private Const DT_TABSTOP = &H80
Private Const DT_TOP = &H0
Private Const DT_WORDBREAK = &H10
Private Const DT_VCENTER = &H4

Public Function mDrawText(ByVal NHwnd As Long, ByVal NText As String, ByVal nColor As Long, ByVal NAlign As AlignmentConstants)
    Dim NHdC As Long
    Dim NLen As Long
    Dim NRect As RECT
    Dim mNAlign As Long
    
    NRect.Left = 0
    NRect.Top = 0
    
    GetWindowCoordinates NHwnd, , NRect.Bottom, , , NRect.Right
    
    NLen = Len(NText)
    NHdC = GetDC(NHwnd)
    SetTextColor NHdC, nColor
    
    Select Case NAlign
        Case vbLeftJustify
            mNAlign = DT_LEFT
        Case vbRightJustify
            mNAlign = DT_RIGHT
        Case vbCenter
            mNAlign = DT_CENTER
    End Select
    
    DrawText NHdC, NText, NLen, NRect, NAlign
    
End Function


Public Function CopyPictures(NHwnD1 As Long, NHwnD2 As Long, Optional WaitTime As Long = 0) As Long
    Dim TempPixel As Long
    Dim sX, sY, sHeight As Single
    Dim sWidth As Single
    Dim NHdc1, NHdc2 As Long
    Dim TempEnable1, TempEnable2 As Long
    TempEnable2 = IsWindowEnabled(NHwnD2)
    EnableWindow NHwnD1, 0
    EnableWindow NHwnD2, 0
    NHdc1 = GetWindowDC(NHwnD1)
    NHdc2 = GetWindowDC(NHwnD2)
    GetWindowCoordinates NHwnD1, , , sHeight, , , sWidth
    For sX = 0 To sWidth
        For sY = 0 To sHeight
            TempPixel = GetPixel(NHdc1, sX, sY)
            CopyPictures = SetPixelV(NHdc2, sX, sY, TempPixel)
            If WaitTime Then Beep 10, WaitTime
            DoEvents
        Next sY
        DoEvents
    Next sX
    ReleaseDC NHwnD1, NHdc1
    ReleaseDC NHwnD2, NHdc2
    EnableWindow NHwnD2, TempEnable2
End Function

Public Function SuperCopyPictures(NHwnD1 As Long, NHwnD2 As Long) As Long
    Dim TempPixel As Long
    Dim sX, sY, sHeight As Single
    Dim sWidth As Single
    Dim NHdc1, NHdc2 As Long
    Dim TempEnable1, TempEnable2 As Long
    TempEnable2 = IsWindowEnabled(NHwnD2)
    EnableWindow NHwnD1, 0
    EnableWindow NHwnD2, 0
    NHdc1 = GetWindowDC(NHwnD1)
    NHdc2 = GetWindowDC(NHwnD2)
    GetWindowCoordinates NHwnD1, , , sHeight, , , sWidth
    For sX = 0 To sWidth
        For sY = 0 To sHeight
            TempPixel = GetPixel(NHdc1, sX, sY)
            SuperCopyPictures = SetPixelV(NHdc2, sX, sY, TempPixel)
        Next sY
    Next sX
    ReleaseDC NHwnD1, NHdc1
    ReleaseDC NHwnD2, NHdc2
    EnableWindow NHwnD2, TempEnable2
End Function

Public Function SetTermalView(NHwnd As Long, Optional WaitTime As Long = 0)
    Dim TempPixel As Long
    Dim sX, sY, sHeight As Single
    Dim sWidth As Single
    Dim NHdC As Long
    Dim TempEnable As Long
    TempEnable = IsWindowEnabled(NHwnd)
    EnableWindow NHwnd, 0
    NHdC = GetWindowDC(NHwnd)
    GetWindowCoordinates NHwnd, , , sHeight, , , sWidth
    For sX = 0 To sWidth
        For sY = 0 To sHeight
            TempPixel = GetPixel(NHdC, sX, sY)
            TempPixel = CLng(TempPixel * 5)
            SetPixelV NHdC, sX, sY, TempPixel
            If WaitTime Then Beep 10, WaitTime
            DoEvents
        Next sY
        DoEvents
    Next sX
    ReleaseDC NHwnd, NHdC
    EnableWindow NHwnd, TempEnable
End Function

Public Function DropColor(NHwnd As Long, NColors As MCOLORS, Optional NValue As Long = 25, Optional WaitTime As Long = 0)
    Dim TempPixel As Long
    Dim sX, sY, sHeight As Single
    Dim sWidth As Single
    Dim NHdC As Long
    Dim nR As Long
    Dim nG As Long
    Dim nB As Long
    Dim TempEnable As Long
    TempEnable = IsWindowEnabled(NHwnd)
    EnableWindow NHwnd, 0
    NHdC = GetWindowDC(NHwnd)
    GetWindowCoordinates NHwnd, , , sHeight, , , sWidth
    For sX = 0 To sWidth
        For sY = 0 To sHeight
            TempPixel = GetPixel(NHdC, sX, sY)
            GetRGB TempPixel, nR, nG, nB
            Select Case NColors
                Case Red
                    TempPixel = RGB(CByte(NValue), nG, nB)
                Case Green
                    TempPixel = RGB(nR, CByte(NValue), nB)
                Case Blue
                    TempPixel = RGB(nR, nG, CByte(NValue))
            End Select
            SetPixelV NHdC, sX, sY, TempPixel
            If WaitTime Then Beep 10, WaitTime
            DoEvents
        Next sY
        DoEvents
    Next sX
    ReleaseDC NHwnd, NHdC
    EnableWindow NHwnd, TempEnable
End Function

Public Function SetBlue(NHwnd As Long, Optional NLevel As Long = 2, Optional WaitTime As Long = 0)
    Dim TempPixel As Long
    Dim sX, sY, sHeight As Single
    Dim sWidth As Single
    Dim NHdC As Long
    Dim nR As Long
    Dim nG As Long
    Dim nB As Long
    Dim TempEnable As Long
    TempEnable = IsWindowEnabled(NHwnd)
    EnableWindow NHwnd, 0
    NHdC = GetWindowDC(NHwnd)
    GetWindowCoordinates NHwnd, , , sHeight, , , sWidth
    For sX = 0 To sWidth
        For sY = 0 To sHeight
            TempPixel = GetPixel(NHdC, sX, sY)
            GetRGB TempPixel, nR, nG, nB
            TempPixel = RGB(Abs(Int(nR / NLevel)), Abs(Int(nG / NLevel)), nB)
            SetPixelV NHdC, sX, sY, TempPixel
            DoEvents
        Next sY
        If WaitTime Then Beep 10, WaitTime
        DoEvents
    Next sX
    ReleaseDC NHwnd, NHdC
    EnableWindow NHwnd, TempEnable
End Function

Public Function SetGreen(NHwnd As Long, Optional NLevel As Long = 2, Optional WaitTime = 0)
    Dim TempPixel As Long
    Dim sX, sY, sHeight As Single
    Dim sWidth As Single
    Dim NHdC As Long
    Dim nR As Long
    Dim nG As Long
    Dim nB As Long
    Dim TempEnable As Long
    TempEnable = IsWindowEnabled(NHwnd)
    EnableWindow NHwnd, 0
    NHdC = GetWindowDC(NHwnd)
    GetWindowCoordinates NHwnd, , , sHeight, , , sWidth
    For sX = 0 To sWidth
        For sY = 0 To sHeight
            TempPixel = GetPixel(NHdC, sX, sY)
            GetRGB TempPixel, nR, nG, nB
            TempPixel = RGB(Abs(Int(nR / NLevel)), nG, Abs(Int(nB / NLevel)))
            SetPixelV NHdC, sX, sY, TempPixel
            If WaitTime Then Beep 10, WaitTime
            DoEvents
        Next sY
        DoEvents
    Next sX
    ReleaseDC NHwnd, NHdC
    EnableWindow NHwnd, TempEnable
End Function

Public Function SetRed(NHwnd As Long, Optional NLevel As Long = 2, Optional WaitTime As Long = 0)
    Dim TempPixel As Long
    Dim sX, sY, sHeight As Single
    Dim sWidth As Single
    Dim NHdC As Long
    Dim nR As Long
    Dim nG As Long
    Dim nB As Long
    Dim TempEnable As Long
    TempEnable = IsWindowEnabled(NHwnd)
    EnableWindow NHwnd, 0
    NHdC = GetWindowDC(NHwnd)
    GetWindowCoordinates NHwnd, , , sHeight, , , sWidth
    For sX = 0 To sWidth
        For sY = 0 To sHeight
            TempPixel = GetPixel(NHdC, sX, sY)
            GetRGB TempPixel, nR, nG, nB
            TempPixel = RGB(nR, Abs(Int(nG / NLevel)), Abs(Int(nB / NLevel)))
            SetPixelV NHdC, sX, sY, TempPixel
            DoEvents
        Next sY
        If WaitTime Then Beep 10, WaitTime
        DoEvents
    Next sX
    ReleaseDC NHwnd, NHdC
    EnableWindow NHwnd, TempEnable
End Function


Public Function GetWindowCoordinates(ByVal NHwnd As Long, Optional NTop As Single, Optional NBottom As Single, Optional NHeight As Single, Optional NLeft As Single, Optional NRight As Single, Optional NWidth As Single) As Long
    Dim TempRect As RECT
    GetWindowCoordinates = GetWindowRect(NHwnd, TempRect)
    'TempRect.Bottom = TempRect.Bottom * Screen.TwipsPerPixelY
    'TempRect.Top = TempRect.Top * Screen.TwipsPerPixelY
    'TempRect.Left = TempRect.Left * Screen.TwipsPerPixelX
    'TempRect.Right = TempRect.Right * Screen.TwipsPerPixelX
    NTop = TempRect.Top
    NBottom = TempRect.Bottom
    NHeight = NBottom - NTop
    NLeft = TempRect.Left
    NRight = TempRect.Right
    NWidth = NRight - NLeft
End Function

Public Function GetRGB(Colors As Long, Red As Long, Green As Long, Blue As Long)
    Dim IndexColor As Long
    IndexColor = Colors
    Red = IndexColor - Int(IndexColor / 256) * 256
    IndexColor = (IndexColor - Red) / 256
    Green = IndexColor - Int(IndexColor / 256) * 256
    IndexColor = (IndexColor - Green) / 256
    
    Blue = IndexColor
    Red = CLng(Abs(Red))
    Green = CLng(Abs(Green))
    Blue = CLng(Abs(Blue))
End Function

Public Sub ByteMe(ByRef TempVar As Long)
    If TempVar > 255 Then TempVar = 255: Exit Sub
    If TempVar < 0 Then TempVar = 0: Exit Sub
End Sub

Public Sub ReverseByte(TmpVar As Long)
    If TmpVar > 255 Then TmpVar = 0
    If TmpVar < 0 Then TmpVar = 255
End Sub

Public Sub AdjustByte(TmpVar As Long, LowValue As Long, HighValue As Long)
    If TmpVar > 255 Then TmpVar = HighValue
    If TmpVar < 0 Then TmpVar = LowValue
End Sub

Public Function CreatePictureEffects(ByVal NPicBox As PictureBox, xFileName1 As String, xFileName2 As String, xFileName3 As String)
    On Error GoTo errhandler
    Set NPicBox.Picture = CaptureObject(NPicBox)
    On Error GoTo errhandler
    SavePicture NPicBox.Picture, xFileName1
    On Error GoTo errhandler
    Set NPicBox.Picture = CaptureObject(NPicBox)
    On Error GoTo errhandler
    SavePicture NPicBox.Picture, xFileName2
    On Error GoTo errhandler
    Set NPicBox.Picture = LoadPicture(xFileName1)
    On Error GoTo errhandler
    Set NPicBox.Picture = CaptureObject(NPicBox)
    On Error GoTo errhandler
    SavePicture NPicBox.Picture, xFileName3
    On Error GoTo errhandler
    Set NPicBox.Picture = LoadPicture(xFileName1)
    Exit Function
errhandler:
    If Dir(xFileName1) <> "" Then
        On Error Resume Next
        Kill xFileName1
    End If
    If Dir(xFileName2) <> "" Then
        On Error Resume Next
        Kill xFileName2
    End If
    If Dir(xFileName3) <> "" Then
        On Error Resume Next
        Kill xFileName3
    End If
    Exit Function
End Function

Public Sub DrawGradient(ByVal eColor As Long, MyTextBox As Object, Optional eStep As Byte = 5)
    Dim mRed As Long
    Dim mGreen As Long
    Dim mBlue As Long
    Dim mCnt As Long
    'MyTextBox.Move MyTextBox.Left, MyTextBox.Top, 255, 255
    With MyTextBox
        GetRGB eColor, mRed, mGreen, mBlue
        
        .AutoRedraw = True
        .DrawStyle = vbInsideSolid
        .DrawMode = vbCopyPen
        .ScaleMode = vbPixels
        .DrawWidth = 2
        .ScaleHeight = 256
        
        For mCnt = 0 To 255
            If mCnt Mod eStep = 0 Then
                mRed = mRed - 1
                'InReturn mRed, 255, 128
                InByte mRed
                mGreen = mGreen - 1
                'InReturn mGreen, 255, 128
                InByte mGreen
                mBlue = mBlue - 1
                'InReturn mBlue, 255, 128
                InByte mBlue
            End If
            .ForeColor = RGB(mRed, mGreen, mBlue)
            MyTextBox.Line (0, mCnt)-(Screen.Width, mCnt - 1)
        Next mCnt
    End With
End Sub


Public Function InByte(mVar As Long) As Long
    If mVar > 255 Then
        mVar = 255
    ElseIf mVar < 0 Then
        mVar = 0
    End If
    InByte = mVar
End Function

Public Function InReturn(mVar As Long, ByVal iMax As Long, ByVal iReturn As Long) As Long
    If mVar >= iMax Then mVar = iReturn
    InReturn = mVar
End Function

Public Function DecrementRGB(ByVal Colors As Long, Optional R As Long = 10, Optional G As Long = 10, Optional B As Long = 10) As Long
    Dim Red As Long
    Dim Green As Long
    Dim Blue As Long
    GetRGB Colors, Red, Green, Blue
    
    Red = Red - R
    InByte Red
    Green = Green - G
    InByte Green
    Blue = Blue - B
    InByte Blue
    
    DecrementRGB = RGB(Red, Green, Blue)
    
End Function

Public Function IncrementRGB(ByVal Colors As Long, Optional R As Long = 10, Optional G As Long = 10, Optional B As Long = 10) As Long
    Dim Red As Long
    Dim Green As Long
    Dim Blue As Long
    GetRGB Colors, Red, Green, Blue
    
    Red = Red + R
    InByte Red
    Green = Green + G
    InByte Green
    Blue = Blue + B
    InByte Blue
    
    IncrementRGB = RGB(Red, Green, Blue)
    
End Function
