Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Convert images using GDI+

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Convert images using GDI+

    Code:
    ' =========================================================================
    ' With these wrapper functions you can easily convert pictures from one
    ' format to another using GDI+, e.g.
    ' nStatus = ConvertImageToJpeg("D:\FOTOS\TEST.BMP", "D:\FOTOS\TEST.JPG")
    ' =========================================================================
    
    #COMPILE EXE
    #DEBUG ERROR ON
    #DIM ALL
    #INCLUDE "WIN32API.INC"
    
    TYPE GdiplusStartupInput
    
       GdiplusVersion AS DWORD             '// Must be 1
       DebugEventCallback AS DWORD         '// Ignored on free builds
       SuppressBackgroundThread AS LONG    '// FALSE unless you're prepared to call
                                           '// the hook/unhook functions properly
       SuppressExternalCodecs AS LONG      '// FALSE unless you want GDI+ only to use
                                           '// its internal image codecs.
    END TYPE
    
    TYPE GdiplusStartupOutput
    
    '  // The following 2 fields are NULL if SuppressBackgroundThread is FALSE.
    '  // Otherwise, they are functions which must be called appropriately to
    '  // replace the background thread.
    '  //
    '  // These should be called on the application's main message loop - i.e.
    '  // a message loop which is active for the lifetime of GDI+.
    '  // "NotificationHook" should be called before starting the loop,
    '  // and "NotificationUnhook" should be called after the loop ends.
    
       NotificationHook AS DWORD
       NotificationUnhook AS DWORD
    
    END TYPE
    
    TYPE ImageCodecInfo
    
       ClassID AS GUID            '// CLSID. Codec identifier
       FormatID AS GUID           '// GUID. File format identifier
       CodecName AS DWORD         '// WCHAR*. Pointer to a null-terminated string
                                  '// that contains the codec name
       DllName AS DWORD           '// WCHAR*. Pointer to a null-terminated string
                                  '// that contains the path name of the DLL in
                                  '// which the codec resides. If the codec is not
                                  '// a DLL, this pointer is NULL
       FormatDescription AS DWORD '// WCHAR*. Pointer to a null-terminated string
                                  '// that contains the name of the format used by the codec
       FilenameExtension AS DWORD '// WCHAR*. Pointer to a null-terminated string
                                  '// that contains all file-name extensions associated
                                  '// with the codec. The extensions are separated with semicolons.
       MimeType AS DWORD          '// WCHAR*. Pointer to a null-terminated string
                                  '// that contains the mime type of the codec
       Flags AS DWORD             '// Combination of flags from the ImageCodecFlags enumeration
       Version AS DWORD           '// Integer that indicates the version of the codec
       SigCount AS DWORD          '// Integer that indicates the number of signatures
                                  '// used by the file format associated with the codec
       SigSize AS DWORD           '// Integer that indicates the number of bytes of each signature
       SigPattern AS DWORD        '// BYTE*. Pointer to an array of bytes that contains
                                  '// the pattern for each signature
       SigMask AS DWORD           '// BYTE*. Pointer to an array of bytes that contains
                                  '// the mask for each signature
    END TYPE
    
    DECLARE FUNCTION GdiplusStartup LIB "GDIPLUS.DLL" ALIAS "GdiplusStartup" _
                (token AS DWORD, inputbuf AS GdiplusStartupInput, outputbuf AS GdiplusStartupOutput) AS LONG
    DECLARE SUB GdiplusShutdown LIB "GDIPLUS.DLL" ALIAS "GdiplusShutdown" _
                (BYVAL token AS DWORD)
    DECLARE FUNCTION GdipLoadImageFromFile LIB "GDIPLUS.DLL" ALIAS "GdipLoadImageFromFile" _
                (BYVAL flname AS STRING, lpImage AS DWORD) AS LONG
    DECLARE FUNCTION GdipDisposeImage LIB "GDIPLUS.DLL" ALIAS "GdipDisposeImage" _
                (BYVAL lpImage AS DWORD) AS LONG
    DECLARE FUNCTION GdipGetImageEncodersSize LIB "GDIPLUS.DLL" ALIAS "GdipGetImageEncodersSize" _
                (numEncoders AS DWORD, nSize AS DWORD) AS LONG
    DECLARE FUNCTION GdipGetImageEncoders LIB "GDIPLUS.DLL" ALIAS "GdipGetImageEncoders" _
                (BYVAL numEncoders AS DWORD, BYVAL nSize AS DWORD, BYVAL lpEncoders AS DWORD) AS LONG
    DECLARE FUNCTION GdipSaveImageToFile LIB "GDIPLUS.DLL" ALIAS "GdipSaveImageToFile" _
                (BYVAL lpImage AS DWORD, BYVAL flname AS STRING, clsidEncoder AS GUID, OPTIONAL BYVAL EncoderParams AS DWORD) AS LONG
    
    
    FUNCTION GDIP_Image_LoadFromFile(BYVAL flname AS STRING, lpImage AS DWORD) AS DWORD
       flname = UCODE$(flname)
       FUNCTION = GdipLoadImageFromFile(flname, lpImage)
    END FUNCTION
    
    FUNCTION GDIP_Image_Delete(BYVAL lpImage AS DWORD) AS LONG
       FUNCTION = GdipDisposeImage(lpImage)
    END FUNCTION
    
    FUNCTION ReadUnicodeString (BYVAL lp AS DWORD) AS STRING
       LOCAL p AS BYTE PTR, s AS STRING
       p = lp                             '// Pointer to the string
       IF p = %NULL THEN EXIT FUNCTION    '// Null pointer
       WHILE CHR$(@p) <> $NUL
          s = s + CHR$(@p)
          p = p + 2                       '// Unicode strings require two bytes per character
       WEND
       FUNCTION = s
    END FUNCTION
    
    ' ==========================================================================
    ' GetEncoderClsid
    ' The function GetEncoderClsid in the following example receives the MIME
    ' type of an encoder and returns the class identifier (CLSID) of that encoder.
    ' The MIME types of the encoders built into GDI+ are as follows:
    '   image/bmp
    '   image/jpeg
    '   image/gif
    '   image/tiff
    '   image/png
    ' ==========================================================================
    FUNCTION GetEncoderClsid (BYVAL sMimeType AS STRING) AS STRING
    
       DIM pImageCodecInfo AS ImageCodecInfo PTR
       LOCAL numEncoders AS DWORD, nSize AS DWORD
       LOCAL lRslt AS LONG, i AS LONG, x AS LONG
       LOCAL p AS BYTE PTR, s AS STRING
       LOCAL nSigCount AS LONG, nSigSize AS LONG
    
       sMimeType = UCASE$(sMimeType)
    
       lRslt = GdipGetImageEncodersSize(numEncoders, nSize)
       REDIM buffer(nSize - 1) AS BYTE
       pImageCodecInfo = VARPTR(buffer(0))
       lRslt = GdipGetImageEncoders(numEncoders, nSize, pImageCodecInfo)
    
       IF lRslt = 0 THEN
          FOR i = 1 TO numEncoders
             IF INSTR(UCASE$(ReadUnicodeString(@pImageCodecInfo.MimeType)), sMimeType) THEN
                FUNCTION = GUIDTXT$(@pImageCodecInfo.ClassID)
                EXIT FOR
             END IF
             INCR pImageCodecInfo       '// Increments pointer
          NEXT
       END IF
    
    END FUNCTION
    
    FUNCTION GDIP_Image_SaveToFile (BYVAL lpImage AS DWORD, BYVAL flname AS STRING, _
             clsidEncoder AS GUID, OPTIONAL BYVAL EncoderParams AS DWORD) AS LONG
       flname = UCODE$(flname)
       FUNCTION = GdipSaveImageToFile(lpImage, flname, clsidEncoder, EncoderParams)
    END FUNCTION
    
    FUNCTION ConvertImage(BYVAL LoadFlName AS STRING, BYVAL SaveFlName AS STRING, BYVAL sMimeType AS STRING) AS LONG
    
       LOCAL token AS DWORD, nStatus AS LONG
       LOCAL StartupInput AS GdiplusStartupInput
       LOCAL StartupOutput AS GdiplusStartupOutput
       LOCAL s AS STRING, sEncoderClsid AS GUID
       LOCAL lpImage AS DWORD
    
       IF TRIM$(LoadFlName) = "" THEN EXIT FUNCTION
       IF TRIM$(SaveFlName) = "" THEN EXIT FUNCTION
    
       StartupInput.GdiplusVersion = 1
       nStatus = GdiplusStartup(token, StartupInput, BYVAL %NULL)
       IF nStatus THEN
          PRINT "Error initializing GDI+"
          EXIT FUNCTION
       END IF
    
       s = GetEncoderClsid(sMimeType)
       IF s = "" THEN
          PRINT "Encoder not installed"
          EXIT FUNCTION
       END IF
       sEncoderClsid = GUID$(s)
    
       nStatus = GDIP_Image_LoadFromFile(LoadFlName, lpImage)
       IF nStatus THEN
          FUNCTION = nStatus
          EXIT FUNCTION
       END IF
    
       IF lpImage THEN
          nStatus = GDIP_Image_SaveToFile(lpImage, SaveFlName, sEncoderClsid)
          IF nStatus THEN
             GDIP_Image_Delete lpImage
             FUNCTION = nStatus
             EXIT FUNCTION
          END IF
       END IF
    
       GDIP_Image_Delete lpImage
       GdiplusShutdown token
    
    END FUNCTION
    
    FUNCTION ConvertImageToBmp(BYVAL LoadFlName AS STRING, BYVAL SaveFlName AS STRING) AS LONG
       FUNCTION = ConvertImage(LoadFlName, SaveFlName, "image/bmp")
    END FUNCTION
    
    FUNCTION ConvertImageToJpeg(BYVAL LoadFlName AS STRING, BYVAL SaveFlName AS STRING) AS LONG
       FUNCTION = ConvertImage(LoadFlName, SaveFlName, "image/jpeg")
    END FUNCTION
    
    FUNCTION ConvertImageToGif(BYVAL LoadFlName AS STRING, BYVAL SaveFlName AS STRING) AS LONG
       FUNCTION = ConvertImage(LoadFlName, SaveFlName, "image/gif")
    END FUNCTION
    
    FUNCTION ConvertImageToTiff(BYVAL LoadFlName AS STRING, BYVAL SaveFlName AS STRING) AS LONG
       FUNCTION = ConvertImage(LoadFlName, SaveFlName, "image/tiff")
    END FUNCTION
    
    FUNCTION ConvertImageToPng(BYVAL LoadFlName AS STRING, BYVAL SaveFlName AS STRING) AS LONG
       FUNCTION = ConvertImage(LoadFlName, SaveFlName, "image/png")
    END FUNCTION
    
    FUNCTION PBMAIN
    
       LOCAL nStatus AS LONG
       nStatus = ConvertImageToJpeg("D:\FOTOS\TEST.BMP", "D:\FOTOS\TEST.JPG")
       IF nStatus THEN
          PRINT "Failure, status = "nStatus
       ELSE
          PRINT "The file was converted succesfully"
       END IF
       WAITKEY$
    
    END FUNCTION

    ------------------
Working...
X