Cjpeg

[Bourne]

bueno aca consegui un modulo que me sirvio
lo pongo por si a alguien le interesa

Option Explicit

' ----==== GDIPlus Const ====----
Public Const GdiPlusVersion As Long = 1
Private Const mimeJPG As String = "image/jpeg"
Private Const mimePNG As String = "image/png"
Private Const mimeTIFF As String = "image/tiff"

Private Const EncoderParameterValueTypeLong As Long = 4
Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Private Const EncoderCompression As String = "{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"
' ----==== Sonstige Types ====----
Private Type PICTDESC
cbSizeOfStruct As Long
picType As Long
hgdiObj As Long
hPalOrXYExt As Long
End Type

Private Type IID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

' ----==== GDIPlus Types ====----
Private Type GDIPlusStartupInput
GdiPlusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

Private Type GdiplusStartupOutput
NotificationHook As Long
NotificationUnhook As Long
End Type

Private Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As Long
End Type

Private Type EncoderParameters
Count As Long
Parameter(15) As EncoderParameter
End Type

Private Type ImageCodecInfo
Clsid As GUID
FormatID As GUID
CodecNamePtr As Long
DllNamePtr As Long
FormatDescriptionPtr As Long
FilenameExtensionPtr As Long
MimeTypePtr As Long
Flags As Long
Version As Long
SigCount As Long
SigSize As Long
SigPatternPtr As Long
SigMaskPtr As Long
End Type

' ----==== GDI+ 5.xx und 6.xx Enumerationen ====----
Private Type ARGB
Blue As Byte
Green As Byte
Red As Byte
Alpha As Byte
End Type

Private Type ColorPalette
Flags As PaletteFlags
Count As Long
Entries As ARGB
End Type

Public Enum EncoderValueConstants
EncoderValueColorTypeCMYK = 0
EncoderValueColorTypeYCCK = 1
EncoderValueCompressionLZW = 2
EncoderValueCompressionCCITT3 = 3
EncoderValueCompressionCCITT4 = 4
EncoderValueCompressionRle = 5
EncoderValueCompressionNone = 6
EncoderValueScanMethodInterlaced = 7
EncoderValueScanMethodNonInterlaced = 8
EncoderValueVersionGif87 = 9
EncoderValueVersionGif89 = 10
EncoderValueRenderProgressive = 11
EncoderValueRenderNonProgressive = 12
EncoderValueTransformRotate90 = 13
EncoderValueTransformRotate180 = 14
EncoderValueTransformRotate270 = 15
EncoderValueTransformFlipHorizontal = 16
EncoderValueTransformFlipVertical = 17
EncoderValueMultiFrame = 18
EncoderValueLastFrame = 19
EncoderValueFlush = 20
EncoderValueFrameDimensionTime = 21
EncoderValueFrameDimensionResolution = 22
EncoderValueFrameDimensionPage = 23
End Enum

Private Enum PaletteFlags
PaletteFlagsHasAlpha = &H1
PaletteFlagsGrayScale = &H2
PaletteFlagsHalftone = &H4
End Enum

Private Enum PixelFormats
PixelFormatUndefined = &H0&
PixelFormatDontCare = PixelFormatUndefined
PixelFormatMax = &HF&
PixelFormat1_8 = &H100&
PixelFormat4_8 = &H400&
PixelFormat8_8 = &H800&
PixelFormat16_8 = &H1000&
PixelFormat24_8 = &H1800&
PixelFormat32_8 = &H2000&
PixelFormat48_8 = &H3000&
PixelFormat64_8 = &H4000&
PixelFormat16bppRGB555 = &H21005
PixelFormat16bppRGB565 = &H21006
PixelFormat16bppGrayScale = &H101004
PixelFormat16bppARGB1555 = &H61007
PixelFormat24bppRGB = &H21808
PixelFormat32bppRGB = &H22009
PixelFormat32bppARGB = &H26200A
PixelFormat32bppPARGB = &HD200B
PixelFormat48bppRGB = &H10300C
PixelFormat64bppARGB = &H34400D
PixelFormat64bppPARGB = &H1C400E
PixelFormatGDI = &H20000
PixelFormat1bppIndexed = &H30101
PixelFormat4bppIndexed = &H30402
PixelFormat8bppIndexed = &H30803
PixelFormatAlpha = &H40000
PixelFormatIndexed = &H10000
PixelFormatPAlpha = &H80000
PixelFormatExtended = &H100000
PixelFormatCanonical = &H200000
End Enum
' ----==== Sonstige Enumerationen ====----
Public Enum TifCompressionType
' EncoderValueConstants.EncoderValueCompressionLZW
TiffCompressionLZW = 2
'EncoderValueConstants.EncoderValueCompressionCCIT T3
TiffCompressionCCITT3 = 3
'EncoderValueConstants.EncoderValueCompressionCCIT T4
TiffCompressionCCITT4 = 4
'EncoderValueConstants.EncoderValueCompressionRle
TiffCompressionRle = 5
'EncoderValueConstants.EncoderValueCompressionNone
TiffCompressionNone = 6
End Enum
' ----==== GDIPlus Enums ====----
Public Enum Status 'GDI+ Status
ok = 0
GenericError = 1
InvalidParameter = 2
OutOfMemory = 3
ObjectBusy = 4
InsufficientBuffer = 5
NotImplemented = 6
Win32Error = 7
WrongState = 8
Aborted = 9
FileNotFound = 10
ValueOverflow = 11
AccessDenied = 12
UnknownImageFormat = 13
FontFamilyNotFound = 14
FontStyleNotFound = 15
NotTrueTypeFont = 16
UnsupportedGdiplusVersion = 17
GdiplusNotInitialized = 18
PropertyNotFound = 19
PropertyNotSupported = 20
ProfileNotFound = 21
End Enum
' ----==== GDI+ 6.xx Enumerationen ====----
Private Enum DitherType
DitherTypeNone = 0
DitherTypeSolid = 1
DitherTypeOrdered4x4 = 2
DitherTypeOrdered8x8 = 3
DitherTypeOrdered16x16 = 4
DitherTypeOrdered91x91 = 5
DitherTypeSpiral4x4 = 6
DitherTypeSpiral8x8 = 7
DitherTypeDualSpiral4x4 = 8
DitherTypeDualSpiral8x8 = 9
DitherTypeErrorDiffusion = 10
End Enum

Private Enum PaletteType
PaletteTypeCustom = 0
PaletteTypeOptimal = 1
PaletteTypeFixedBW = 2
PaletteTypeFixedHalftone8 = 3
PaletteTypeFixedHalftone27 = 4
PaletteTypeFixedHalftone64 = 5
PaletteTypeFixedHalftone125 = 6
PaletteTypeFixedHalftone216 = 7
PaletteTypeFixedHalftone252 = 8
PaletteTypeFixedHalftone256 = 9
End Enum
' ----==== GDI+ 5.xx und 6.xx API Deklarationen ====----
Private Declare Function GdipCloneBitmapArea Lib "gdiplus" _
(ByVal X As Single, ByVal Y As Single, ByVal Width As Single, _
ByVal Height As Single, ByVal format As PixelFormats, _
ByVal srcBitmap As Long, ByRef dstBitmap As Long) As Status

Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
(ByVal FileName As Long, ByRef BITMAP As Long) As Status

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
(ByVal hbm As Long, ByVal hpal As Long, _
ByRef BITMAP As Long) As Status

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _
(ByVal BITMAP As Long, ByRef hbmReturn As Long, _
ByVal background As Long) As Status

Private Declare Function GdipDisposeImage Lib "gdiplus" _
(ByVal image As Long) As Status

Private Declare Function GdipGetImageEncoders Lib "gdiplus" _
(ByVal numEncoders As Long, ByVal Size As Long, _
ByRef Encoders As Any) As Status

Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" _
(ByRef numEncoders As Long, ByRef Size As Long) As Status

Private Declare Function GdipGetImagePixelFormat Lib "gdiplus" _
(ByVal image As Long, ByRef PixelFormat As PixelFormats) As Status

Private Declare Function GdipGetImageDimension Lib "gdiplus" _
(ByVal image As Long, ByRef sngWidth As Single, _
ByRef sngHeight As Single) As Status

Private Declare Function GdiplusShutdown Lib "gdiplus" _
(ByVal token As Long) As Status

Private Declare Function GdiplusStartup Lib "gdiplus" _
(ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _
Optional ByRef lpOutput As Any) As Status

Private Declare Function GdipSaveImageToFile Lib "gdiplus" _
(ByVal image As Long, ByVal FileName As Long, _
ByRef clsidEncoder As GUID, _
ByRef encoderParams As Any) As Status

' ----==== GDI+ 6.xx API Deklarationen ====----
Private Declare Function GdipBitmapConvertFormat Lib "gdiplus" _
(ByVal pInputBitmap As Long, _
ByVal PixelFormat As PixelFormats, _
ByVal DitherType As DitherType, _
ByVal PaletteType As PaletteType, _
ByVal palette As Any, _
ByVal alphaThresholdPercent As Single) As Status

Private Declare Function GdipInitializePalette Lib "gdiplus" _
(ByVal palette As Any, _
ByVal PaletteType As PaletteType, _
ByVal optimalColors As Long, _
ByVal useTransparentColor As Long, _
ByVal BITMAP As Long) As Status

' ----==== OLE API Declarations ====----
Private Declare Function CLSIDFromString Lib "ole32" _
(ByVal str As Long, id As GUID) As Long

Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" _
(lpPictDesc As PICTDESC, riid As IID, ByVal fOwn As Boolean, _
lplpvObj As Object)