Attribute VB_Name = "modScale2xVb"
Option Explicit

'Scale2x VB Implementation
'2004 by SmokingFish
'mail@SmokingFish.de

'Original Algorythm by Andrea Mazzoleni (2001)
'http://scale2x.sourceforge.net/

Public Declare Function SCALE2X_Scale2x_Point Lib "scale2x.dll" (ByVal Array1 As Long, ByVal Array2 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_Scale2x Lib "scale2x.dll" (ByVal Array1 As Long, ByVal Array2 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_Scale2x_Ext Lib "scale2x.dll" (ByVal Array1 As Long, ByVal Array2 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_Scale3x_Point Lib "scale2x.dll" (ByVal Array1 As Long, ByVal Array2 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_Scale3x Lib "scale2x.dll" (ByVal Array1 As Long, ByVal Array2 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_Scale3x_Ext Lib "scale2x.dll" (ByVal Array1 As Long, ByVal Array2 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_GreyScale Lib "scale2x.dll" (ByVal Array1 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_Negative Lib "scale2x.dll" (ByVal Array1 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_Smooth Lib "scale2x.dll" (ByVal Array1 As Long, ByVal sw As Long, ByVal sh As Long) As Long
Public Declare Function SCALE2X_SetPitch Lib "scale2x.dll" (ByVal cpitch As Long) As Long

Dim x As Integer
Dim y As Integer
    
Dim A As Long, b As Long, C As Long
Dim D As Long, E As Long, F As Long
Dim g As Long, H As Long, i As Long
Dim r As Long

Dim E0 As Long, E1 As Long, E2 As Long
Dim E3 As Long, E4 As Long, E5 As Long
Dim E6 As Long, E7 As Long, E8 As Long

Private Mode As String

Public Sub GreyScale(Array1() As Long, sw As Integer, sh As Integer)

    If Mode = "VB" Then

    For y = 0 To sh - 1
        For x = 0 To sw - 1
        
            r = Array1(0, x, y) And &H10000FF
            g = (Array1(0, x, y) And &H100FF00) / (2 ^ 8)
            b = (Array1(0, x, y) And &H100FF00) / (2 ^ 16)
            D = (r + g + b) / 3
            
            Array1(0, x, y) = RGB(D, D, D)
            
        Next x
    Next y
    
    Else
    
    SCALE2X_GreyScale VarPtr(Array1(0, 0, 0)), sw, sh
    
    End If

End Sub

Public Sub NegativeImage(Array1() As Long, sw As Integer, sh As Integer)

    If Mode = "VB" Then
  
    For y = 0 To sh - 1
        For x = 0 To sw - 1
        
            Array1(0, x, y) = 255 - Array1(0, x, y)
            
        Next x
    Next y
    
    Else
    
    SCALE2X_Negative VarPtr(Array1(0, 0, 0)), sw, sh
  
    End If
    
End Sub

Public Sub Smooth(Array1() As Long, sw As Integer, sh As Integer)

    If Mode = "VB" Then
  
    For y = 1 To sh - 2
        For x = 1 To sw - 2
    
            r = CLng(Array1(0, x, y) And &H10000FF) + _
            CLng(Array1(0, x - 1, y) And &H10000FF) + CLng(Array1(0, x, y - 1) And &H10000FF) + _
            CLng(Array1(0, x, y + 1) And &H10000FF) + CLng(Array1(0, x + 1, y) And &H10000FF)
            r = r \ 5
      
            g = CLng((Array1(0, x, y) And &H100FF00) / (2 ^ 8)) + _
            CLng((Array1(0, x - 1, y) And &H100FF00) / (2 ^ 8)) + CLng((Array1(0, x, y - 1) And &H100FF00) / (2 ^ 8)) + _
            CLng((Array1(0, x, y + 1) And &H100FF00) / (2 ^ 8)) + CLng((Array1(0, x + 1, y) And &H100FF00) / (2 ^ 8))
            g = g \ 5
      
            b = CLng((Array1(0, x, y) And &H100FF00) / (2 ^ 16)) + _
            CLng((Array1(0, x - 1, y) And &H100FF00) / (2 ^ 16)) + CLng((Array1(0, x, y - 1) And &H100FF00) / (2 ^ 16)) + _
            CLng((Array1(0, x, y + 1) And &H100FF00) / (2 ^ 16)) + CLng((Array1(0, x + 1, y) And &H100FF00) / (2 ^ 16))
            b = b \ 5

            Array1(0, x, y) = RGB(r, g, b)

        Next x
    Next y
    
    Else
    
    SCALE2X_Smooth VarPtr(Array1(0, 0, 0)), sw, sh
  
    End If

End Sub

Public Sub Scale2xPoint(Array1() As Long, Array2() As Long, sw As Integer, sh As Integer)
On Error Resume Next
    
    If Mode = "VB" Then
    
    For y = 0 To sh - 1
        For x = 0 To sw - 1
                      
                E = Array1(0, x, y)
                
                Array2(0, x * 2, y * 2) = E
                Array2(0, x * 2 + 1, y * 2) = E
                Array2(0, x * 2, y * 2 + 1) = E
                Array2(0, x * 2 + 1, y * 2 + 1) = E
                
        Next
    Next
    
    Else

    SCALE2X_Scale2x_Point VarPtr(Array1(0, 0, 0)), VarPtr(Array2(0, 0, 0)), sw, sh

    End If

End Sub

Public Sub Scale2x(Array1() As Long, Array2() As Long, sw As Integer, sh As Integer)
On Error Resume Next

    If Mode = "VB" Then

    For y = 0 To sh - 1
        For x = 0 To sw - 1
                      
                A = Array1(0, x - 1, y - 1)
                b = Array1(0, x, y - 1)
                C = Array1(0, x + 1, y - 1)
                D = Array1(0, x - 1, y)
                E = Array1(0, x, y)
                F = Array1(0, x + 1, y)
                g = Array1(0, x - 1, y + 1)
                H = Array1(0, x, y + 1)
                i = Array1(0, x + 1, y + 1)
                
                If (D = b) And (Not b = F) And (Not D = H) Then E0 = D Else E0 = E
                If (b = F) And (Not b = D) And (Not F = H) Then E1 = F Else E1 = E
                If (D = H) And (Not D = b) And (Not H = F) Then E2 = D Else E2 = E
                If (H = F) And (Not D = H) And (Not b = F) Then E3 = F Else E3 = E
                
                Array2(0, x * 2, y * 2) = E0
                Array2(0, x * 2 + 1, y * 2) = E1
                Array2(0, x * 2, y * 2 + 1) = E2
                Array2(0, x * 2 + 1, y * 2 + 1) = E3
                
        Next
    Next
    
    Else

    SCALE2X_Scale2x VarPtr(Array1(0, 0, 0)), VarPtr(Array2(0, 0, 0)), sw, sh
    
    End If

End Sub

Public Sub Scale2xExt(Array1() As Long, Array2() As Long, sw As Integer, sh As Integer)
On Error Resume Next

    If Mode = "VB" Then

    For y = 0 To sh - 1
        For x = 0 To sw - 1
                      
                A = Array1(0, x - 1, y - 1)
                b = Array1(0, x, y - 1)
                C = Array1(0, x + 1, y - 1)
                D = Array1(0, x - 1, y)
                E = Array1(0, x, y)
                F = Array1(0, x + 1, y)
                g = Array1(0, x - 1, y + 1)
                H = Array1(0, x, y + 1)
                i = Array1(0, x + 1, y + 1)
                
                If (Not b = H And Not D = F) Then
                    If (D = b) Then E0 = D Else E0 = E
                    If (b = F) Then E1 = F Else E1 = E
                    If (D = H) Then E2 = D Else E2 = E
                    If (H = F) Then E3 = F Else E3 = E
                Else
                    E0 = E
                    E1 = E
                    E2 = E
                    E3 = E
                End If
                
                Array2(0, x * 2, y * 2) = E0
                Array2(0, x * 2 + 1, y * 2) = E1
                Array2(0, x * 2, y * 2 + 1) = E2
                Array2(0, x * 2 + 1, y * 2 + 1) = E3
                
        Next
    Next
    
    Else

    SCALE2X_Scale2x_Ext VarPtr(Array1(0, 0, 0)), VarPtr(Array2(0, 0, 0)), sw, sh
    
    End If

End Sub

Public Sub Scale3xPoint(Array1() As Long, Array2() As Long, sw As Integer, sh As Integer)
On Error Resume Next
    
    If Mode = "VB" Then
    
    For y = 0 To sh - 1
        For x = 0 To sw - 1
                      
                E = Array1(0, x, y)
                
                Array2(0, x * 3, y * 3) = E
                Array2(0, x * 3 + 1, y * 3) = E
                Array2(0, x * 3 + 2, y * 3) = E
                
                Array2(0, x * 3, y * 3 + 1) = E
                Array2(0, x * 3 + 1, y * 3 + 1) = E
                Array2(0, x * 3 + 2, y * 3 + 1) = E
                
                Array2(0, x * 3, y * 3 + 2) = E
                Array2(0, x * 3 + 1, y * 3 + 2) = E
                Array2(0, x * 3 + 2, y * 3 + 2) = E
                
        Next
    Next
    
    Else
    
    SCALE2X_Scale3x_Point VarPtr(Array1(0, 0, 0)), VarPtr(Array2(0, 0, 0)), sw, sh
    
    End If

End Sub

Public Sub Scale3x(Array1() As Long, Array2() As Long, sw As Integer, sh As Integer)
On Error Resume Next

    If Mode = "VB" Then

    For y = 0 To sh - 1
        For x = 0 To sw - 1
                      
                A = Array1(0, x - 1, y - 1)
                b = Array1(0, x, y - 1)
                C = Array1(0, x + 1, y - 1)
                D = Array1(0, x - 1, y)
                E = Array1(0, x, y)
                F = Array1(0, x + 1, y)
                g = Array1(0, x - 1, y + 1)
                H = Array1(0, x, y + 1)
                i = Array1(0, x + 1, y + 1)
                
                If (D = b) And (Not b = F) And (Not D = H) Then E0 = D Else E0 = E
                If ((D = b) And (Not b = F) And (Not D = H) And (Not E = C)) Or ((b = F) And (Not b = D) And (Not F = H) And (Not E = A)) Then E1 = b Else E1 = E
                If (b = F) And (Not b = D) And (Not F = H) Then E2 = F Else E2 = E
                If ((D = b) And (Not b = F) And (Not D = H) And (Not E = g)) Or ((D = b) And (Not b = F) And (Not D = H) And (Not E = A)) Then E3 = D Else E3 = E
                E4 = E
                If ((b = F) And (Not b = D) And (Not F = H) And (Not E = i)) Or ((H = F) And (Not D = H) And (Not b = F) And (Not E = C)) Then E5 = F Else E5 = E
                If (D = H) And (Not D = b) And (Not H = F) Then E6 = D Else E6 = E
                If ((D = H) And (Not D = b) And (Not H = F) And (Not E = i)) Or ((H = F) And (Not D = H) And (Not b = F) And (Not E = g)) Then E7 = H Else E7 = E
                If (H = F) And (Not D = H) And (Not b = F) Then E8 = F Else E8 = E
                
                Array2(0, x * 3, y * 3) = E0
                Array2(0, x * 3 + 1, y * 3) = E1
                Array2(0, x * 3 + 2, y * 3) = E2
                
                Array2(0, x * 3, y * 3 + 1) = E3
                Array2(0, x * 3 + 1, y * 3 + 1) = E4
                Array2(0, x * 3 + 2, y * 3 + 1) = E5
                
                Array2(0, x * 3, y * 3 + 2) = E6
                Array2(0, x * 3 + 1, y * 3 + 2) = E7
                Array2(0, x * 3 + 2, y * 3 + 2) = E8
                
        Next
    Next
    
    Else
    
    SCALE2X_Scale3x VarPtr(Array1(0, 0, 0)), VarPtr(Array2(0, 0, 0)), sw, sh
    
    End If

End Sub

Public Sub Scale3xExt(Array1() As Long, Array2() As Long, sw As Integer, sh As Integer)
On Error Resume Next

    If Mode = "VB" Then

    For y = 0 To sh - 1
        For x = 0 To sw - 1
                      
                A = Array1(0, x - 1, y - 1)
                b = Array1(0, x, y - 1)
                C = Array1(0, x + 1, y - 1)
                D = Array1(0, x - 1, y)
                E = Array1(0, x, y)
                F = Array1(0, x + 1, y)
                g = Array1(0, x - 1, y + 1)
                H = Array1(0, x, y + 1)
                i = Array1(0, x + 1, y + 1)
                
                If (Not b = H) And (Not D = F) Then
                    If (D = b) Then E0 = D Else E0 = E
                    If ((D = b) And (Not E = C)) Or ((b = F) And (Not E = A)) Then E1 = b Else E1 = E
                    If (b = F) Then E2 = F Else E2 = E
                    If ((D = b) And (Not E = g)) Or ((D = b) And (Not E = A)) Then E3 = D Else E3 = E
                    E4 = E
                    If ((b = F) And (Not E = i)) Or ((H = F) And (Not E = C)) Then E5 = F Else E5 = E
                    If (D = H) Then E6 = D Else E6 = E
                    If ((D = H) And (Not E = i)) Or ((H = F) And (Not E = g)) Then E7 = H Else E7 = E
                    If (H = F) Then E8 = F Else E8 = E
                Else
                    E0 = E
                    E1 = E
                    E2 = E
                    E3 = E
                    E4 = E
                    E5 = E
                    E6 = E
                    E7 = E
                    E8 = E
                End If
                
                Array2(0, x * 3, y * 3) = E0
                Array2(0, x * 3 + 1, y * 3) = E1
                Array2(0, x * 3 + 2, y * 3) = E2
                
                Array2(0, x * 3, y * 3 + 1) = E3
                Array2(0, x * 3 + 1, y * 3 + 1) = E4
                Array2(0, x * 3 + 2, y * 3 + 1) = E5
                
                Array2(0, x * 3, y * 3 + 2) = E6
                Array2(0, x * 3 + 1, y * 3 + 2) = E7
                Array2(0, x * 3 + 2, y * 3 + 2) = E8
                
        Next
    Next
    
    Else
    
    SCALE2X_Scale3x_Ext VarPtr(Array1(0, 0, 0)), VarPtr(Array2(0, 0, 0)), sw, sh
    
    End If

End Sub
