gistfile1.vb

Private Sub Command1_Click()
Dim TextureBPP As Long
Dim i&, mydib1&, mydib2&

If List1.ListCount > 0 Then

For i& = 0 To List1.ListCount - 1
        
            mydib1 = 0: mydib2 = 0
            
        Select Case LCase$(GetFileExtension(List1.List(i)))
            Case ".jpg": mydib1 = FreeImage_Load(FIF_JPEG, List1.List(i))
            Case ".png": mydib1 = FreeImage_Load(FIF_PNG, List1.List(i))
            Case ".tga":  mydib1 = FreeImage_Load(FIF_TARGA, List1.List(i))
            Case ".bmp":  mydib1 = FreeImage_Load(FIF_BMP, List1.List(i))
            Case Else: MsgBox "Unknown file format for texture: " + List1.List(i)
        End Select
            If mydib1 = 0 Then
            MsgBox "Failed to load Targa.", _
                    vbExclamation, _
                    "File Input Error"
            Else
                TextureBPP = FreeImage_GetBPP(mydib1)
                   
                mydib2 = FreeImage_ConvertColorDepth(mydib1, FICF_PALETTISED_8BPP, False, , , FIQ_WUQUANT, 224, DMMToolPaletteNoFullBrights, 224)
                mydib2 = FreeImage_ConvertColorDepth(mydib1, FICF_PALETTISED_8BPP, False, , , FIQ_NNQUANT, 224, DMMToolAntiPaletteNoFullBrights, 224)
    
                If mydib2 = 0 Then
                    MsgBox "Palette reduction failed on " + Chr$(34) + Chr$(34)
                Else
                    If FreeImage_Save(FIF_BMP, mydib2, List1.List(i) + "3dmm.bmp") = 0 Then '
                        MsgBox "Failed to save 3dmm Bitmap " & List1.List(i) & ".", _
                                vbExclamation, _
                            "File Input Error"
                    End If
                        FreeImage_Unload (mydib2)
                    End If
                FreeImage_Unload (mydib1)
            End If

Next
    MsgBox "Done processing textures.", vbOKOnly, "3DMM Paletterizer"
Else
    MsgBox "There are no items to be converted!", vbOKOnly, "3DMM Paletterizer"
End If

End Sub