Creación de un módulo de clase de manipulación de imágenes VBA WIA

Con los años, he publicado numerosos artículos sobre 1 de las funciones de WIA:

Cómo recortar una imagen usando WIA en VBA

Anteriormente publiqué varios artículos sobre la manipulación de imágenes con VBA, cosas como: Recientemente, tenía a alguien que me preguntara: Respuesta corta, por supuesto!

VBA – WIA – Flip una imagen

Estaba ayudando en una discusión en el foro sobre manipular imágenes, volteándolas específicamente y publiqué parte de mi código allí, así que pensé en compartirlo aquí para que todos los demás se beneficiaran. Una vez más, ¡WIA tiene todo lo que necesitamos para realizar esta tarea rápida y fácilmente! WIA ofrece a los desarrolladores 2 propiedades de procesamiento de imágenes: Fliphorizontal y Flipvertical que solo necesitamos aplicar. A continuación hay algunas funciones de muestra que ilustran cómo se puede implementar fácilmente.

y muchos otros.

Decidí que exploro tomar todas estas funciones y transformarlas en un módulo de clase.

¿Por qué un módulo de clase?

¡Gran pregunta! Sobre todo por diversión y aprendizaje.

Los módulos de clase nos ofrecen algunas capacidades excelentes como verá el código presentado a continuación.

Originalmente, me puse a querer ver si podía replicar algo de lo que había logrado con mi demostración de FreeImage.

¿Podríamos construir algo similar (no idéntico) utilizando solo un módulo simple y varias funciones, sin duda, pero este artículo pretende ser otra herramienta de aprendizaje de módulo de clase?

Con respecto a los módulos de clase específicamente, algunos podrían señalar ventajas como:

• Programación orientada a objetos
• Intelisense
• …

El módulo de clase

A continuación se muestra el módulo de clase que construí a partir de mis diversas funciones de WIA y otros dabbles.

En mi caso, agregué un nuevo módulo de clase a mi proyecto y lo renombré ‘CLS_WIA’ e inserté el siguiente código.

Option Compare Database
Option Explicit

'--- cls_WIA ---
Private Const CLASS_NAME      As String = "cls_WIA"

Private mInputFile            As String
Private mOutputFile           As String
Private mImageFile            As Object    ' WIA.ImageFile
Private mImageProcess         As Object    ' WIA.ImageProcess
Private mLoaded               As Boolean

Public Enum wiaFormat
    wiaFormatBMP = 0
    wiaFormatGIF = 1
    wiaFormatJPEG = 2
    wiaFormatJPG = 2
    wiaFormatPNG = 3
    wiaFormatTIFF = 4
End Enum


'==============================
' Properties
'==============================

Public Property Get ClassName() As String
    ClassName = CLASS_NAME
End Property

Public Property Let InputFile(ByVal sFile As String)
    mInputFile = sFile
    LoadImageFile
    mLoaded = True
    Set mImageFile = Nothing
    Set mImageProcess = Nothing
End Property

Public Property Get InputFile() As String
    InputFile = mInputFile
End Property

Public Property Let OutputFile(ByVal sFile As String)
    mOutputFile = sFile
End Property

Public Property Get OutputFile() As String
    OutputFile = mOutputFile
End Property

' Read-only property for the WIA.ImageFile object
Public Property Get ImageFile() As Object
    If mImageFile Is Nothing Or Not mLoaded Then
        LoadImageFile
    End If
    Set ImageFile = mImageFile
End Property

' Read-only property for the WIA.ImageProcess object
Public Property Get ImageProcess() As Object
    If mImageProcess Is Nothing Then
        Set mImageProcess = CreateObject("WIA.ImageProcess")
    End If
    Set ImageProcess = mImageProcess
End Property

' Read-only property for the Filters count
Public Property Get FiltersCount() As Long
    FiltersCount = Me.ImageProcess.Filters.Count
End Property

Public Sub Clear() 'not a prop, I know
    Set mImageFile = Nothing
End Sub


'==============================
' Public Methods
'==============================

Private Sub LoadImageFile()
    If mInputFile = "" Then _
       Err.Raise vbObjectError + 1000, CLASS_NAME, _
       "No Input File Defined.  Use .InputFile to define the image file."
    Set mImageFile = CreateObject("WIA.ImageFile")
    mImageFile.LoadFile mInputFile
    mLoaded = True
    Set mImageProcess = Nothing
End Sub

' Applies all filters in mImageProcess to mImageFile and resets mImageProcess
Public Sub ApplyFilters()
    If mImageFile Is Nothing Then LoadImageFile
    If Not mImageProcess Is Nothing And mImageProcess.Filters.Count > 0 Then
        Set mImageFile = mImageProcess.Apply(mImageFile)
        Set mImageProcess = Nothing
    End If
End Sub

' Reload image from file (if needed)
Public Sub ReloadImage()
    LoadImageFile
End Sub

' Save the current image (after processing)
Public Sub Save(Optional ByVal sOutputPath As String = "")
    Dim sTargetPath           As String

    If mImageFile Is Nothing Then _
       Err.Raise vbObjectError + 515, CLASS_NAME, _
       "No image loaded or filters applied. Call ApplyFilters before Save."

    ' Priority: outputPath argument > OutputFile property > InputFile property
    If sOutputPath <> "" Then
        sTargetPath = sOutputPath
    ElseIf mOutputFile <> "" Then
        sTargetPath = mOutputFile
    ElseIf mInputFile <> "" Then
        sTargetPath = mInputFile
    Else
        Err.Raise vbObjectError + 514, CLASS_NAME, "No output path or input file specified."
    End If

    ' Overwrite the original file first if it exists
    '   ***** Maybe add a user prompt to confirm *****
    If Dir(sTargetPath) <> "" Then Kill sTargetPath

    '    ' Next 3 lines are optional depending on the approach you wish to use.
    '    If Not mImageProcess Is Nothing And mImageProcess.Filters.Count > 0 Then
    '        ApplyFilters
    '    End If

    mImageFile.SaveFile sTargetPath
End Sub

' Rotate by 90, 180, or 270 degrees
Public Sub Rotate(iAngle As Integer)
    Dim oIP                   As Object

    If iAngle = 0 Then Exit Sub     'Nothing to do with a 0 angle!

    If iAngle = -180 Then iAngle = 180
    If iAngle = -90 Then iAngle = 270

    ' Only accept 90, 180, 270 as angles
    If iAngle <> 90 _
       And iAngle <> 180 _
       And iAngle <> 270 Then
        Err.Raise vbObjectError + 513, CLASS_NAME, "Rotation angle must be 90, 180, or 270."
    End If

    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("RotateFlip").FilterID
    oIP.Filters(oIP.Filters.Count).Properties("RotationAngle") = iAngle
End Sub

' Flip horizontally and/or vertically
Public Sub Flip(Optional bFlipHorizontally As Boolean = False, _
                Optional bFlipVertically As Boolean = False)
    Dim oIP                   As Object
    
    If Not bFlipHorizontally And Not bFlipVertically Then Exit Sub
    
    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("RotateFlip").FilterID
    If bFlipHorizontally Then oIP.Filters(oIP.Filters.Count).Properties("FlipHorizontal") = True
    If bFlipVertically Then oIP.Filters(oIP.Filters.Count).Properties("FlipVertical") = True
End Sub

' Queues a Scale filter (resize) to the ImageProcess
Public Sub Resize(lMaximumWidth As Long, _
                  lMaximumHeight As Long, _
                  Optional bPreserveAspectRatio As Boolean = True)
    Dim oIP                   As Object
    
    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("Scale").FilterID
    With oIP.Filters(oIP.Filters.Count)
        .Properties("MaximumWidth") = lMaximumWidth
        .Properties("MaximumHeight") = lMaximumHeight
        .Properties("PreserveAspectRatio") = bPreserveAspectRatio
    End With
End Sub

' Define the format/quality of the output file
Public Sub ConvertImage(lTargetFormat As wiaFormat, _
                        Optional lQuality As Long = 85)
    Dim sFormatID             As String
    Dim oIP                   As Object

    Select Case lTargetFormat
        Case wiaFormatBMP
            sFormatID = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
        Case wiaFormatGIF
            sFormatID = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
        Case wiaFormatJPEG
            sFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
        Case wiaFormatPNG
            sFormatID = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
        Case wiaFormatTIFF
            sFormatID = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
        Case Else
            Err.Raise vbObjectError + 520, CLASS_NAME, "Unsupported format."
    End Select

    If lQuality > 100 Then lQuality = 100
    If lQuality < 0 Then lQuality = 0 'Kind of useless, perhaps we should set a minimum???

    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("Convert").FilterID
    With oIP.Filters(oIP.Filters.Count)
        .Properties("FormatID") = sFormatID
        If lTargetFormat = wiaFormatJPEG Then
            .Properties("Quality") = lQuality
        End If
    End With
End Sub

' List all EXIF properties
Public Function GetExifPropertyValues() As String
    Dim oIF                   As Object    ' WIA.ImageFile
    Dim prop                  As Object   ' WIA.Property
    Dim props()               As Variant
    Dim i As Long, j          As Long
    Dim temp                  As Variant
    Dim sOutput               As String

    Set oIF = Me.ImageFile

    ' Creat to an array of the properties where the 1st element is the property name, for sorting
    ReDim props(1 To oIF.Properties.Count, 1 To 2)
    i = 1
    For Each prop In oIF.Properties
        props(i, 1) = prop.Name
        Set props(i, 2) = prop
        i = i + 1
    Next

    ' ort the array by prop.Name
    For i = 1 To UBound(props) - 1
        For j = i + 1 To UBound(props)
            If StrComp(props(i, 1), props(j, 1), vbTextCompare) > 0 Then
                temp = props(i, 1)
                props(i, 1) = props(j, 1)
                props(j, 1) = temp

                Set temp = props(i, 2)
                Set props(i, 2) = props(j, 2)
                Set props(j, 2) = temp
            End If
        Next j
    Next i

    ' Build the output from sorted array
    sOutput = "Name~Decimal~HEX~Type~Type~Value" & vbCrLf
    For i = 1 To UBound(props)
        Set prop = props(i, 2)
        sOutput = sOutput & prop.Name & _
                  "~" & prop.PropertyID & _
                  "~" & DecimalToHex(prop.PropertyID) & _
                  "~" & GetVarTypeName(VarType(prop.Value)) & _
                  "~" & GetWiaImagePropertyType(prop.Type) & _
                  "~" & GetPropertyValueAsString(prop) & vbCrLf
    Next

    GetExifPropertyValues = sOutput
End Function

' Sets an EXIF property (ID, Type, Value) using the EXIF filter
Public Sub SetExifProperty(lPropertyId As Long, _
                           lPropertyType As Long, _
                           vPropertyValue As Variant)
    Dim oIP                   As Object

    Set oIP = Me.ImageProcess
    oIP.Filters.Add oIP.FilterInfos("Exif").FilterID
    With oIP.Filters(oIP.Filters.Count)
        .Properties("ID") = lPropertyId
        .Properties("Type") = lPropertyType
        .Properties("Value") = vPropertyValue
    End With
End Sub

Sub RemoveExifProperty(lPropertyId As Long)
    Dim oIF                   As Object
    Dim oIP                   As Object
    Dim oProp                 As Object

    If lPropertyId <> 269 Then    'We have to leave the DocumentName property!
        Set oIF = Me.ImageFile
        Set oIP = Me.ImageProcess

        With oIP
            .Filters.Add (.FilterInfos("Exif").FilterID)
            .Filters(oIP.Filters.Count).Properties("ID") = lPropertyId
            .Filters(oIP.Filters.Count).Properties("Remove") = True
        End With
    End If
End Sub

Sub RemoveAllExifProperties()
    Dim oIF                   As Object
    Dim oIP                   As Object
    Dim oProp                 As Object

    Set oIF = Me.ImageFile
    Set oIP = Me.ImageProcess

    For Each oProp In oIF.Properties
        If oProp.PropertyID <> 269 Then    'We have to leave the DocumentName property!
            With oIP
                .Filters.Add (.FilterInfos("Exif").FilterID)
                .Filters(oIP.Filters.Count).Properties("ID") = oProp.PropertyID
                .Filters(oIP.Filters.Count).Properties("Remove") = True
            End With
        End If
    Next oProp
End Sub

' Returns the binary data of the loaded image as a byte array
'   this can be used with an Access' Image control  Me.ImgCtrl.PictureData = .GetBinaryData
Public Function GetBinaryData() As Variant
    If mImageFile Is Nothing Then _
       Err.Raise vbObjectError + 516, CLASS_NAME, _
       "No image loaded. Load an image before calling GetBinaryData."
    GetBinaryData = mImageFile.fileData.BinaryData
End Function

' Get StdPicture for use in forms or clipboard
Public Function GetStdPicture() As StdPicture
    Set GetStdPicture = mImageFile.fileData.Picture
End Function

' Orient image based on Orientation property value
Public Sub AutoOrient()
    Dim oIF                   As Object
    Dim vOrientation          As Variant
    Dim bPropertyExists       As Boolean

    Set oIF = Me.ImageFile

    'ReOrient the image based on the Orientation Exif Property value
    If oIF.Properties.Exists("274") Then
        vOrientation = oIF.Properties("274").Value
        bPropertyExists = True

        Select Case vOrientation
                ' Case 1: Normal, do nothing
            Case 2: Me.Flip bFlipHorizontally:=True
            Case 3: Me.Rotate 180
            Case 4: Me.Flip bFlipVertically:=True
            Case 5: Me.Rotate 90: Me.Flip bFlipHorizontally:=True
            Case 6: Me.Rotate 90
            Case 7: Me.Rotate 270: Me.Flip bFlipHorizontally:=True
            Case 8: Me.Rotate 270
        End Select
    End If

    ' Reset the Orientation property to "1" (normal) if it existed
    If bPropertyExists Then _
       Me.SetExifProperty 274, 1003, 1
End Sub

Function WIA_GetAllExifProperties(sImage As String)
'
    On Error GoTo Error_Handler
    '#Const WIA_EarlyBind = False    'True => Early Binding / False => Late Binding
    #If WIA_EarlyBind = True Then
        'Early Binding req: Microsoft Windows Image Acquisition Library vX.X
        Dim oIF               As WIA.ImageFile
        Dim oV                As WIA.Vector
        Dim oPrp              As WIA.Property

        Set oIF = New WIA.ImageFile
        Set oV = New WIA.Vector
    #Else
        Dim oIF               As Object
        Dim oV                As Object
        Dim oPrp              As Variant
        Const RationalImagePropertyType = 1006    '(&H3EE)

        Set oIF = CreateObject("WIA.ImageFile")
        Set oV = CreateObject("WIA.Vector")
    #End If
    Dim sValue                As String
    Dim lCounter              As Long
    Dim lCounter2             As Long

    oIF.LoadFile sImage

    Debug.Print "No.", "ID", "Name", "Type", "Value"
    On Error Resume Next
    For Each oPrp In oIF.Properties
        lCounter = lCounter + 1    'Element counter
        With oPrp
            If .PropertyID <> 20507 And .PropertyID <> 20624 And .PropertyID <> 20625 Then
                If .IsVector = False Then
                    If .Type = RationalImagePropertyType Then
                        Debug.Print lCounter, .PropertyID, .Name, GetWiaImagePropertyType(.Type), .Value.Numerator & "/" & .Value.Denominator
                    Else
                        Debug.Print lCounter, .PropertyID, .Name, GetWiaImagePropertyType(.Type), .Value
                    End If
                Else
                    'Vector objects
                    Set oV = .Value
                    For lCounter2 = 1 To oV.Count
                        sValue = sValue & oV.Item(lCounter2) & " "
                    Next lCounter2
                    sValue = Trim(sValue)
                    Debug.Print lCounter, .PropertyID, .Name, GetWiaImagePropertyType(.Type), sValue
                End If
            End If
        End With
    Next oPrp

Error_Handler_Exit:
    On Error Resume Next
    If Not oV Is Nothing Then Set oV = Nothing
    If Not oIF Is Nothing Then Set oIF = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: WIA_GetExifProperty" & vbCrLf & _
           "Error Description: " & Err.description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has occurred!"
    Resume Error_Handler_Exit
End Function

Function GetPropertyValueAsString(oProp As Variant) As String
    Dim sOutput               As String
    Dim sOutput2              As String
    Dim oV                    As Object    'As WIA.Vector
    Dim lCounter              As Long
    Const RationalImagePropertyType = 1006

    With oProp
        ' 20507 => Thumbnail Data
        ' 20624 => Luminance Table
        ' 20625 =>
        If .PropertyID <> 20507 And .PropertyID <> 20624 And .PropertyID <> 20625 Then
            If .IsVector = False Then
                If .Type = RationalImagePropertyType Then
                    sOutput = .Value.Numerator & "/" & .Value.Denominator
                Else
                    sOutput = .Value
                End If
            Else
                'Vector objects
                Set oV = .Value
                For lCounter = 1 To oV.Count
                    sOutput = sOutput & Chr(oV.Item(lCounter))
                    sOutput2 = sOutput2 & oV.Item(lCounter) & " "
                Next lCounter
                sOutput = Trim(sOutput) & " | " & Trim(sOutput2)
                'Debug.Print lCounter, .PropertyID, .Name, GetWiaImagePropertyType(.Type), sValue
            End If
        Else
            sOutput = "(--- Omitted ---)"
        End If
    End With

    GetPropertyValueAsString = sOutput
End Function


'==============================
' Private Helpers
'==============================

Function GetVarTypeName(vt As Integer) As String
    Select Case vt
        Case vbEmpty: GetVarTypeName = "Empty"
        Case vbNull: GetVarTypeName = "Null"
        Case vbInteger: GetVarTypeName = "Integer"
        Case vbLong: GetVarTypeName = "Long"
        Case vbSingle: GetVarTypeName = "Single"
        Case vbDouble: GetVarTypeName = "Double"
        Case vbCurrency: GetVarTypeName = "Currency"
        Case vbDate: GetVarTypeName = "Date"
        Case vbString: GetVarTypeName = "String"
        Case vbObject: GetVarTypeName = "Object"
        Case vbError: GetVarTypeName = "Error"
        Case vbBoolean: GetVarTypeName = "Boolean"
        Case vbVariant: GetVarTypeName = "Variant"
        Case vbDataObject: GetVarTypeName = "DataObject"
        Case vbByte: GetVarTypeName = "Byte"
        Case vbArray + vbByte: GetVarTypeName = "Byte Array"
        Case vbArray + vbVariant: GetVarTypeName = "Variant Array"
        Case Else: GetVarTypeName = "Unknown/Other"
    End Select
End Function

Public Function GetWiaFormatValue(ByVal sFormatName As String) As Variant
    Select Case LCase(sFormatName)
        Case "wiaformatbmp"
            GetWiaFormatValue = wiaFormat.wiaFormatBMP
        Case "wiaformatgif"
            GetWiaFormatValue = wiaFormat.wiaFormatGIF
        Case "wiaformatjpeg", "wiaformatjpg"
            GetWiaFormatValue = wiaFormat.wiaFormatJPEG
        Case "wiaformatpng"
            GetWiaFormatValue = wiaFormat.wiaFormatPNG
        Case "wiaformattiff"
            GetWiaFormatValue = wiaFormat.wiaFormatTIFF
        Case Else
            GetWiaFormatValue = -1
    End Select
End Function

Private Function GetWiaImagePropertyType(ByVal lType As Long) As String
    Select Case lType
        Case 1000
            GetWiaImagePropertyType = "Undefined"
        Case 1001
            GetWiaImagePropertyType = "Byte"
        Case 1002
            GetWiaImagePropertyType = "String"
        Case 1003
            GetWiaImagePropertyType = "Unsigned Integer"
        Case 1004
            GetWiaImagePropertyType = "Long"
        Case 1005
            GetWiaImagePropertyType = "Unsigned Long"
        Case 1006
            GetWiaImagePropertyType = "Rational"
        Case 1007
            GetWiaImagePropertyType = "Unsigned Rational"
        Case 1100
            GetWiaImagePropertyType = "Vector Of Undefined"
        Case 1101
            GetWiaImagePropertyType = "Vector Of Bytes"
        Case 1102
            GetWiaImagePropertyType = "Vector Of Unsigned"
        Case 1103
            GetWiaImagePropertyType = "Vector Of Longs"
        Case 1104
            GetWiaImagePropertyType = "Vector Of UnsignedLongs"
        Case 1105
            GetWiaImagePropertyType = "Vector Of Rationals"
        Case 1106
            GetWiaImagePropertyType = "Vector Of Unsigned Rationals"
        Case Else
            GetWiaImagePropertyType = "Unknown Type"
    End Select
End Function

' Convert Decimal to Hexadecimal (optionally with the 0x prefix)
Public Function DecimalToHex(lDecValue As Long, _
                             Optional bIncludePrefix As Boolean = True) As String
    DecimalToHex = Hex(lDecValue)
    If bIncludePrefix Then DecimalToHex = "0x" & DecimalToHex
End Function

' Convert Hexadecimal (with 0x prefix) to Decimal
Public Function HexToDecimal(sHexValue As String) As Long
    Dim sCleanHex             As String

    sCleanHex = Replace(sHexValue, "0x", "")
    HexToDecimal = CLng("&H" & sCleanHex)
End Function

Function FormatFileSize(ByVal dNoBytes As Double) As String
    If dNoBytes < 1024 Then
        FormatFileSize = dNoBytes & " B"
    ElseIf dNoBytes < 1048576 Then    ' 1024^2
        FormatFileSize = Format(dNoBytes / 1024, "0.00") & " KB"
    ElseIf dNoBytes < 1073741824 Then    ' 1024^3
        FormatFileSize = Format(dNoBytes / 1048576, "0.00") & " MB"
    Else
        FormatFileSize = Format(dNoBytes / 1073741824, "0.00") & " GB"
    End If
End Function

Ejemplo de uso (s)

Sé que en la primera clase los módulos pueden parecer intimidantes, pero como verá con los ejemplo (s) a continuación, simplifican la codificación.

Obtener información sobre imágenes

    Dim cWIA                  As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"

        ' Access the WIA objects and filters count
        With .ImageFile
            Debug.Print .Width
            Debug.Print .Height
            Debug.Print .HorizontalResolution
            Debug.Print .VerticalResolution
            Debug.Print .IsAnimated
            Debug.Print .ActiveFrame
            Debug.Print .FrameCount
            Debug.Print .FileExtension
            Debug.Print .IsAlphaPixelFormat
            Debug.Print .PixelDepth
            Debug.Print .FormatID
            Debug.Print .IsExtendedPixelFormat
            Debug.Print .IsIndexedPixelFormat
        End With

        .Clear
    End With

    Set cWIA = Nothing

Gire una imagen

    Dim cWIA              As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"
        .OutputFile = "C:\Temp\Landscape_3_rotated.jpg"

        .Rotate 180
        .ApplyFilters

        .Save
        .Clear
    End With
    
    Set cWIA = Nothing

Convierta una imagen de JPG a BMP

    Dim cWIA                  As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"
        .OutputFile = "C:\Temp\Landscape_3.bmp"

        .ConvertImage wiaFormatBMP
        .ApplyFilters

        .Save
        .Clear
    End With

    Set cWIA = Nothing

Autoorient, cambiar el tamaño y convertir una imagen

    Dim cWIA                  As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"
        .OutputFile = "C:\Users\Dev\Desktop\MyPic.png"

        .AutoOrient
        .Resize 300, 300, True
        .ConvertImage wiaFormatPNG
        .ApplyFilters

        .Save
        .Clear
    End With

    Set cWIA = Nothing

Mostrando sus cambios

Una de las cosas realmente buenas con WIA es que, de hecho, puede aplicar cambios en su imagen base y mostrar la imagen resultante sin necesidad de guardar primero el archivo en el disco.

Si tiene un control de imagen, podría hacer algo como:

Me.ImageControlName.PictureData = .GetBinaryData

Entonces, como ejemplo completo, recuperando el ejemplo anterior, podríamos hacer:

    Dim cWIA                  As New cls_WIA

    With cWIA
        .InputFile = "C:\Temp\Landscape_3.jpg"
        .OutputFile = "C:\Users\Dev\Desktop\MyPic.png"

        .AutoOrient
        .Resize 300, 300, True
        .ConvertImage wiaFormatPNG
        .ApplyFilters

        Me.ImageControlName.PictureData = .GetBinaryData
    End With

    Set cWIA = Nothing

Luego proporcionaría un botón separado para guardar los resultados, pero solo cuando el usuario esté listo para guardar las cosas de forma permanente.

Ordenar asuntos

Una cosa importante a tener en cuenta al realizar operaciones en imágenes es que el orden de las operaciones puede afectar la salida final.

Un ejemplo de ello sería que debe hacer su cambio de tamaño o recortar después de haber realizado cualquier rotación necesaria, de lo contrario no obtendrá el resultado final deseado.

Conclusión

¡Así que ahí lo tienes, manipulación de imágenes en su máxima expresión!

Una de las mejores cosas de usar WIA es que realmente puede realizar manipulaciones en la memoria, incluso mostrando/previsualizando los resultados en un control de imagen, sin necesidad de guardar continuamente los cambios en el disco duro, eliminando las operaciones inútiles de E/S. Por lo tanto, solo realiza la operación .save una vez que esté satisfecho con los resultados.

WIA está integrado en Windows, por lo que nada para instalar, es independiente de Bitness, por lo que no se preocupe por unas 32 instalaciones de 64 bits y funciona en todas las aplicaciones VBA (acceso, Excel, Word, Outlook, …).