Download text file
%Testing     = 0
%GDI_Stretch = 1

#if 0
Version 2.01: 5 functions have been added since last posting. Most of the other, existing
              code has not been messed with.

This code imports images from files, resource or the clipboard using GDI+
functions and converts them to PowerBASIC's BMP graphics so they can be
manipulated using PB's functions.

If the incoming image needs to be stretched to fit a particular size then
I've found that the GDI+ functions do a bit better job of it than GRAPHIC
STRETCH. This code is quite simple and will, most likely need some boosting
to get it into a real program but as needs and requirements change in
unforeseeable ways I've not attempted to create the end-all function but
just a simple skeleton as a starting point.

Special thanks go to the following (and some I've most likely missed) for
their input:

General GDI+   Patrice Terrier
Resource Code  Ryan Cross
Debugging      Aslan Babakhanov

Using fGDIp_StartEnd

  This function must be called before anyother of the GDI+ functions to load the DLL
  At this stage if any value other than ZERO is returned then the GDI+ DLL wasn't loaded

  Before closing the program the function should be called again to unload the DLL
  Nothing (of import) is returned at this stage

Using fGDIp_2hBMP

  The FileSpec parameter is used to determine where the image is to be
  loaded from. An incoming NULL value indicates that it is on the clip-
  board. A string starting with the pound sign CHR$(35) indicates a
  resource label and any other string is a file path\name.

  If hBMP's incoming value is non-zero then it is assumed that you wish
  the function to load the image into the existing graphic.

  The function returns:
    ZERO if it has failed or PowerBASIC's BMP handle

  The value of hInst??? in LoadImageFromResouce can be left as ZERO if
  the resource data is in the current program.

Using fGDIp_N2hBMP

  FileSpec (same as above)
  hBMP???  the larger image that the incoming image is to be copied into
  X&, Y&   the offset in the larger image
  XX&, YY& the right/bottom offset in the incoming image

  RETURNS: Zero if successful

  The idea here is to copy an image into an existing BMP. This routine
  was developed for an image browser. The aspect ratio of the incoming
  image is maintaied and it is expected that the area of the BMP is
  ready for the image as any unused area around the incoming image is
  not affected.


Using fGDIp_Twist2hBMP

  FileSpec (same as above)
  XX&, YY& maximum desired size of image
  Twist&   see constants below for 90 left & right and 180

  Once again the image's aspect ratio is automatically maintained. The
  image is then rotated as requested then placed into a BMP which is
  created and returned.


Using fGDIp_GetImageSize

  FileSpec (same as above)

  RETURNS: a 4 byte string that representes a POINTL structure
           eg: TYPE SET tP = fGDIp_GetImageSize(FileSpec)


Using fhBMP_2GDIp

  FileSpec the drive/path of the target file
  hBMP     the image to be saved

  RETURNS: Zero if successful


That should do it! I've set some constants for the file name and resource
label. Use the bit of code directly following to create the test pbr file
with your favorite picture.

Don Schullian
don (at) DASoftVSS (dot)com
#endif
'
'=====================================================
'====== RESOURCE CODE ================================
'=====================================================
'
#IF 0

#INCLUDE "resource.h"

#define jpgtest 1001

jpgtest RCDATA DISCARDABLE "test.jpg"

#ENDIF
'
'=====================================================
'====== TEST CODE ====================================
'=====================================================
'
#if %Testing

#COMPILE EXE
#COMPILER PBWIN 8
#DEBUG ERROR ON
#DIM ALL

#RESOURCE "test.pbr"
#INCLUDE "win32api.inc"

DECLARE FUNCTION fGDIp_StartEnd        () AS LONG
DECLARE FUNCTION fGDIp_2hBMP           (BYVAL FileSpec$,OPT BYVAL hBMP???,BYVAL KeepAspect&,BYVAL BkGrnd&) AS DWORD
DECLARE FUNCTION fGDIp_N2hBMP          (BYVAL FileSpec$,BYVAL hBMP???,BYVAL X&,BYVAL Y&,BYVAL XX&,BYVAL YY&) AS LONG
DECLARE FUNCTION fGDIp_Twist2hBMP      (BYVAL FileSpec$,BYVAL XX&, BYVAL YY&,BYVAL Twist&) AS DWORD
DECLARE FUNCTION fGDIp_GetImageSize    (BYVAL FileSpec$) AS STRING
DECLARE FUNCTION fhBMP_2GDIp           (BYVAL FileSpec$,BYVAL hBMP???) AS LONG

$From_RC     = "#1001"
$From_File   = "Test.jpg"
$From_CBoard = ""
$FileSpec    = $From_File

FUNCTION WINMAIN ( BYVAL hInstance   AS DWORD, _
                   BYVAL hPrevInst   AS DWORD, _
                   BYVAL lpszCmdLine AS ASCIIZ PTR, _
                   BYVAL nCmdShow    AS LONG ) AS LONG

  DIM hBMP          AS LOCAL DWORD
  DIM  BMPx         AS LOCAL SINGLE
  DIM  BMPy         AS LOCAL SINGLE
  DIM hWnd          AS LOCAL DWORD
  DIM  XX           AS LOCAL SINGLE
  DIM  YY           AS LOCAL SINGLE


  IF fGDIp_StartEnd <> 0 THEN
    MSGBOX "No GDI+"
    EXIT FUNCTION
  END IF

#IF %GDI_Stretch
  GRAPHIC BITMAP NEW 300, 400 TO hBMP
#ENDIF

  hBMP = fGDIp_2hBMP($FileSpec,hBMP)

  IF hBMP = 0 THEN
      MSGBOX "Function failed"
    ELSE
      GRAPHIC ATTACH hBMP, 0
      GRAPHIC GET CLIENT TO BMPx, BMPy
      GRAPHIC WINDOW "", 50, 50, 500, 500 TO hWnd
      GRAPHIC ATTACH hWnd, 0
      GRAPHIC COLOR %BLACK, %YELLOW
      GRAPHIC CLEAR
      IF (BMPx > 500) OR (BMPy > 500) THEN
          GRAPHIC STRETCH hBMP, 0, (0, 0)-(BMPx-1,BMPy-1) TO (49,49)-(449,449)
        ELSE
          XX = (500 - BMPx) \ 2
          YY = (500 - BMPy) \ 2
          GRAPHIC COPY hBMP, 0 TO (XX,YY)
      END IF
      SLEEP 3000
      GRAPHIC ATTACH hBMP, 0
      GRAPHIC BITMAP END
      GRAPHIC ATTACH hWnd, 0
      GRAPHIC WINDOW END
  END IF

  fGDIp_StartEnd

END FUNCTION
'
'=====================================================
'====== END TEST CODE ================================
'=====================================================
'
#endif
'
'=====================================================
'====== DECLARATIONS =================================
'=====================================================
'
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
  NotificationHook AS DWORD
  NotificationUnhook AS DWORD
END TYPE

TYPE ImageCodecInfo
  ClassID           AS GUID
  FormatID          AS GUID
  CodecName         AS DWORD
  DllName           AS DWORD
  FormatDescription AS DWORD
  FilenameExtension AS DWORD
  MimeType          AS DWORD
  Flags             AS DWORD
  Version           AS DWORD
  SigCount          AS DWORD
  SigSize           AS DWORD
  SigPattern        AS DWORD
  SigMask           AS DWORD
END TYPE

DECLARE FUNCTION GdiplusStartup              LIB "gdiplus.dll" ALIAS "GdiplusStartup"              (token???, inputbuf AS GdiplusStartupInput, outputbuf AS GdiplusStartupOutput) AS LONG
DECLARE      SUB GdiplusShutdown             LIB "gdiplus.dll" ALIAS "GdiplusShutdown"             (BYVAL token???)
DECLARE FUNCTION GdipDeleteGraphics          LIB "gdiplus.dll" ALIAS "GdipDeleteGraphics"          (BYVAL hGraphics???) AS LONG
DECLARE FUNCTION GdipCreateFromHDC           LIB "gdiplus.dll" ALIAS "GdipCreateFromHDC"           (BYVAL hdc???, hGraphics???) AS LONG
DECLARE FUNCTION GdipLoadImageFromFile       LIB "gdiplus.dll" ALIAS "GdipLoadImageFromFile"       (BYVAL flname$, lpImage???) AS LONG
DECLARE FUNCTION GdipCreateBitmapFromHBITMAP LIB "gdiplus.dll" ALIAS "GdipCreateBitmapFromHBITMAP" (BYVAL hbm&,BYVAL hpal&, nBitmap&) AS LONG
DECLARE FUNCTION GdipCreateBitmapFromStream  LIB "gdiplus.dll" ALIAS "GdipCreateBitmapFromStream"  (BYVAL pStream???,m_pBitmap&) AS LONG
DECLARE FUNCTION CreateStreamOnHGlobal       LIB "ole32.dll"   ALIAS "CreateStreamOnHGlobal"       (BYVAL hGlobal AS DWORD, BYVAL fDeleteOnRelease AS DWORD, pstm AS DWORD) AS LONG
DECLARE FUNCTION GdipDisposeImage            LIB "gdiplus.dll" ALIAS "GdipDisposeImage"            (BYVAL lpImage???) AS LONG
DECLARE FUNCTION GdipDrawImageRectI          LIB "gdiplus.dll" ALIAS "GdipDrawImageRectI"          (BYVAL hGraphics???, BYVAL nImage???, BYVAL x&,BYVAL y&, BYVAL nWidth&, BYVAL nHeight&) AS LONG
DECLARE FUNCTION GdipGetImageWidth           LIB "gdiplus.dll" ALIAS "GdipGetImageWidth"           (BYVAL lpImage???, nWidth???) AS LONG
DECLARE FUNCTION GdipGetImageHeight          LIB "gdiplus.dll" ALIAS "GdipGetImageHeight"          (BYVAL lpImage???, nHeight???) AS LONG
DECLARE FUNCTION GdipGetImageThumbnail       LIB "gdiplus.dll" ALIAS "GdipGetImageThumbnail"       (BYVAL nImage&,BYVAL thumbWidth&,BYVAL thumbHeight&, thumbnImage&, OPT BYVAL pCALLBACK&, OPT BYVAL callbackData&) AS LONG
DECLARE FUNCTION GdipImageRotateFlip         LIB "gdiplus.dll" ALIAS "GdipImageRotateFlip"         (BYVAL nImage&,BYVAL rfType&) 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, OPT BYVAL EncoderParams AS DWORD) AS LONG

%RotateNoneFlipNone = 0
%Rotate90FlipNone   = 1
%Rotate180FlipNone  = 2
%Rotate270FlipNone  = 3
'
'-------------------------------------------
'
DECLARE FUNCTION pStreamRelease        (pUnk???) AS LONG
DECLARE FUNCTION LoadImageFromResource (BYVAL ResourceName$,OPT BYVAL hInst???) AS DWORD
DECLARE FUNCTION fReadUnicodeString    (BYVAL lp???) AS STRING

DECLARE FUNCTION fGDIp_StartEnd        () AS LONG
DECLARE FUNCTION fGDIp_2hBMP           (BYVAL FileSpec$,OPT BYVAL hBMP???,BYVAL KeepAspect&,BYVAL BkGrnd&) AS DWORD
DECLARE FUNCTION fGDIp_N2hBMP          (BYVAL FileSpec$,BYVAL hBMP???,BYVAL X&,BYVAL Y&,BYVAL XX&,BYVAL YY&) AS LONG
DECLARE FUNCTION fGDIp_Twist2hBMP      (BYVAL FileSpec$,BYVAL XX&, BYVAL YY&,BYVAL Twist&) AS DWORD
DECLARE FUNCTION fGDIp_GetImageSize    (BYVAL FileSpec$) AS STRING
DECLARE FUNCTION fhBMP_2GDIp           (BYVAL FileSpec$,BYVAL hBMP???) AS LONG
'
'------------------------------------------------------------------------------
'
FUNCTION fGDIp_StartEnd ALIAS "fGDIp_StartEnd" () EXPORT AS LONG

  DIM GDIok        AS STATIC DWORD

  DIM StartupInput AS LOCAL GDIplusStartupInput

  IF GDIok > 0 THEN
    GDIplusShutdown GDIok
  ELSE
    StartupInput.GDIplusVersion = 1
    FUNCTION = GDIplusStartup(GDIok, StartupInput, BYVAL %NULL)
  END IF

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION LoadImageFromResource (BYVAL ResourceName AS STRING, _
                            OPT BYVAL hInst        AS DWORD   ) AS DWORD

  DIM hResource        AS LOCAL DWORD
  DIM  imageSize       AS LOCAL DWORD
  DIM pResourceData    AS LOCAL DWORD
  DIM m_hBuffer        AS LOCAL DWORD
  DIM pBuffer          AS LOCAL DWORD
  DIM pStream          AS LOCAL DWORD PTR
  DIM m_pBitmap        AS LOCAL DWORD
  DIM m_pBitmap_status AS LOCAL LONG
  DIM pName            AS LOCAL ASCIIZ * %MAX_PATH

  pName = ResourceName

  hResource = FindResource(hInst, pName, BYVAL %RT_RCDATA)
  IF hResource = 0 THEN EXIT FUNCTION

  imageSize = SizeofResource(hInst, hResource)
  IF imageSize = 0 THEN EXIT FUNCTION

  pResourceData = LockResource(LoadResource(hInst, hResource))
  IF pResourceData = 0 THEN EXIT FUNCTION

  m_hBuffer = GlobalAlloc(%GMEM_MOVEABLE, imageSize)
  IF m_hBuffer = 0 THEN EXIT FUNCTION

  pBuffer = GlobalLock(m_hBuffer)
  IF pBuffer = 0 THEN GOTO Exit_1

  CopyMemory (pBuffer, pResourceData, imageSize)
  IF CreateStreamOnHGlobal(m_hBuffer, %FALSE, pStream) <> 0 THEN GOTO Exit_2

  m_pBitmap_status = GdipCreateBitmapFromStream(pStream, m_pBitmap)
  CALL DWORD @@pStream[2] USING pStreamRelease(pStream)
  IF (m_pBitmap       <> 0)  AND _
     (m_pBitmap_status = 0) THEN
    FUNCTION = m_pBitmap
  END IF

  Exit_2:
    GlobalUnlock m_hBuffer
  Exit_1:
    GlobalFree m_hBuffer

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fGDIp_GetImage ( BYVAL FileSpec AS STRING, _
                                Ixx      AS LONG  , _
                                Iyy      AS LONG    ) AS DWORD
  DIM hImage AS LOCAL DWORD
  DIM hTmp   AS LOCAL DWORD

  SELECT CASE ASC(FileSpec)
    CASE -1   : IF OpenClipboard(hTmp) = 0 THEN EXIT FUNCTION
                hTmp = GetClipboardData(%CF_BITMAP)
                IF hTmp <> 0 THEN
                  GDIpCreateBitmapFromHBITMAP hTmp, BYVAL 0, hImage
                END IF
                EmptyClipboard
                CloseClipboard
                IF hImage = 0 THEN EXIT FUNCTION
    CASE 35   : hImage = LoadImageFromResource(FileSpec)
                IF hImage = 0 THEN EXIT FUNCTION
    CASE ELSE : FileSpec = UCODE$(FileSpec)
                IF GdipLoadImageFromFile(FileSpec, hImage) <> 0 THEN EXIT FUNCTION
  END SELECT

  GdipGetImageWidth  hImage, Ixx
  GdipGetImageHeight hImage, Iyy

  FUNCTION = hImage

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fGDIp_GetImageSize ALIAS "fGDIp_GetImageSize" ( BYVAL FileSpec AS STRING ) EXPORT AS STRING

  DIM hImage AS LOCAL DWORD
  DIM tP     AS LOCAL POINTL

  hImage = fGDIp_GetImage(FileSpec,tP.X,tP.Y)

  IF hImage > 0 THEN
    GdipDisposeImage hImage
    FUNCTION = tP
  END IF

END FUNCTION

'
'------------------------------------------------------------------------------
'
FUNCTION fGDIp_2hBMP ALIAS "fGDIp_2hBMP" ( BYVAL FileSpec   AS STRING, _
                                       OPT BYVAL hBMP       AS DWORD , _
                                       OPT BYVAL KeepAspect AS LONG  , _
                                       OPT BYVAL Background AS LONG    ) EXPORT AS DWORD

  DIM  Bx       AS LOCAL LONG
  DIM  Bxx      AS LOCAL LONG
  DIM  By       AS LOCAL LONG
  DIM  Byy      AS LOCAL LONG
  DIM hDC       AS LOCAL DWORD
  DIM hGraphics AS LOCAL DWORD
  DIM  Iaspect  AS LOCAL CUX
  DIM hImage    AS LOCAL DWORD
  DIM  Ixx      AS LOCAL LONG
  DIM  Iyy      AS LOCAL LONG
  DIM hTmp      AS LOCAL DWORD

  hImage = fGDIp_GetImage(FileSpec,Ixx,Iyy)
  IF hImage = 0 THEN EXIT FUNCTION

  IF hBMP = 0 THEN
      Bxx = Ixx
      Byy = Iyy
      GRAPHIC BITMAP NEW Bxx, Byy TO hBMP
      GRAPHIC ATTACH hBMP, 0
      GOSUB Get_DC
    ELSE
      GRAPHIC ATTACH hBMP, 0
      GRAPHIC GET CLIENT TO Bxx, Byy
      GOSUB Get_DC
      IF KeepAspect = 0 THEN
          IF (Bxx <> Ixx)   OR _
             (Byy <> Iyy) THEN
            GdipGetImageThumbnail hImage, Bxx, Byy, hTmp
            SWAP hImage, hTmp
            GdipDisposeImage hTmp
          END IF
        ELSE
          IF BackGround <> -2 THEN
            GRAPHIC CLEAR BackGround
          END IF
          Iaspect = Iyy / Ixx
          IF Byy => (Bxx * Iaspect) THEN
              Iyy = MIN(Bxx,(Bxx * Iaspect))
              By  = (Byy - Iyy) \ 2
              Byy = Iyy
            ELSE
              Iaspect = Ixx / Iyy
              Ixx = MIN(Bxx,Byy * Iaspect)
              Bx  = (Bxx - Ixx) \ 2
              Bxx = Ixx
          END IF
      END IF
  END IF

  GdipDrawImageRectI hGraphics, hImage, Bx, By, Bxx, Byy
  GdipDeleteGraphics hGraphics
  GdipDisposeImage hImage
  FUNCTION = hBMP
  EXIT FUNCTION
  '
  '-------------------------------------
  '
  Get_DC:
    GRAPHIC GET DC TO hDC
    GdipCreateFromHDC hDC, hGraphics
    IF hGraphics <> 0 THEN RETURN
    GdipDisposeImage hImage
    GRAPHIC ATTACH hBMP, 0
    GRAPHIC BITMAP END
  RETURN

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fGDIp_N2hBMP ALIAS "fGDIp_N2hBMP" ( BYVAL FileSpec   AS STRING, _
                                             BYVAL hBMP       AS DWORD , _
                                             BYVAL  X         AS LONG  , _
                                             BYVAL  Y         AS LONG  , _
                                             BYVAL  XX        AS LONG  , _
                                             BYVAL  YY        AS LONG    ) EXPORT AS LONG

  DIM  Bx       AS LOCAL LONG
  DIM  Bxx      AS LOCAL LONG
  DIM  By       AS LOCAL LONG
  DIM  Byy      AS LOCAL LONG
  DIM hDC       AS LOCAL DWORD
  DIM  Enbr     AS LOCAL LONG
  DIM hGraphics AS LOCAL DWORD
  DIM  Iaspect  AS LOCAL CUX
  DIM hImage    AS LOCAL DWORD
  DIM  Ixx      AS LOCAL LONG
  DIM  Iyy      AS LOCAL LONG
  DIM hTmp      AS LOCAL DWORD

  Enbr = 1  ' Set Error flag

  hImage = fGDIp_GetImage(FileSpec,Ixx,Iyy)
  IF hImage = 0 THEN GOTO Oops

  GRAPHIC GET DC TO hDC
  GdipCreateFromHDC hDC, hGraphics
  IF hGraphics = 0 THEN GOTO Oops

  Bxx = XX - X + 1
  Byy = YY - Y + 1

  IF (Ixx > Bxx )   OR _
     (Iyy > Byy ) THEN
      Iaspect = Iyy / Ixx
      IF Byy => (Bxx * Iaspect) THEN
          Iyy = MIN(Bxx,(Bxx * Iaspect))
          By  = (Byy - Iyy) \ 2
          Byy = Iyy
        ELSE
          Iaspect = Ixx / Iyy
          Ixx = MIN(Bxx,Byy * Iaspect)
          Bx  = (Bxx - Ixx) \ 2
          Bxx = Ixx
      END IF
    ELSE
      Bxx = Ixx
      Byy = Iyy
      Bx  = (XX - Bxx) \ 2
      By  = (YY - Byy) \ 2
  END IF

  DECR Enbr

  GdipDrawImageRectI hGraphics, hImage, X+Bx-1, Y+By-1, Bxx, Byy
  GdipDeleteGraphics hGraphics

  Oops:
    GdipDisposeImage hImage
    FUNCTION = Enbr

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fGDIp_Twist2hBMP ALIAS "fGDIp_Twist2hBMP" ( BYVAL FileSpec AS STRING, _
                                                     BYVAL Bxx      AS LONG  , _
                                                     BYVAL Byy      AS LONG  , _
                                                     BYVAL Twist    AS LONG    ) EXPORT AS DWORD

  DIM hBMP      AS LOCAL DWORD
  DIM hDC       AS LOCAL DWORD
  DIM hGraphics AS LOCAL DWORD
  DIM hImage    AS LOCAL DWORD
  DIM  Ixx      AS LOCAL LONG
  DIM  Iyy      AS LOCAL LONG

  hImage = fGDIp_GetImage(FileSpec,Ixx,Iyy)
  IF hImage = 0 THEN EXIT FUNCTION

  IF (Bxx = 0) OR (Byy = 0) THEN
    Bxx = Ixx
    Byy = Iyy
    IF (Twist AND 1) THEN SWAP Bxx, Byy
  END IF

  GRAPHIC BITMAP NEW Bxx, Byy TO hBMP
  GRAPHIC ATTACH hBMP, 0
  GRAPHIC GET DC TO hDC
  GdipCreateFromHDC hDC, hGraphics

  IF hGraphics = 0 THEN
    GdipDisposeImage hImage
    GRAPHIC BITMAP END
    EXIT FUNCTION
  END IF

  IF Twist <> 0 THEN
    GdipImageRotateFlip hImage, Twist
  END IF

  GdipDrawImageRectI hGraphics, hImage, 0, 0, Bxx, Byy
  GdipDeleteGraphics hGraphics
  GdipDisposeImage hImage

  FUNCTION = hBMP

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fReadUnicodeString (BYVAL lp AS DWORD) AS STRING

  DIM p AS LOCAL BYTE PTR
  DIM s AS LOCAL STRING

  p = lp
  WHILE @p > 0
    s = s + CHR$(@p)
    p = p + 2
  WEND

  FUNCTION = s

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fhBMP_2GDIp ALIAS "fhBMP_2GDIp" ( BYVAL FileSpec AS STRING, _
                                           BYVAL hBMP     AS DWORD   ) EXPORT AS LONG

  DIM sMimeType       AS LOCAL STRING
  DIM sEncoderClsid   AS LOCAL GUID
  DIM  Img            AS LOCAL DWORD
  DIM Tmp             AS LOCAL STRING
  DIM numEncoders     AS LOCAL DWORD
  DIM nSize           AS LOCAL DWORD
  DIM nStatus         AS LOCAL LONG
  DIM pImageCodecInfo AS LOCAL ImageCodecInfo PTR

  FileSpec  = TRIM$(FileSpec)
  sMimeType = PARSE$(FileSpec,".",-1)

  SELECT CASE UCASE$(sMimeType)
    CASE "BMP"         : sMimeType = "IMAGE/BMP"
    CASE "EMF"         : sMimeType = "IMAGE/X-EMF"
    CASE "GIF"         : sMimeType = "IMAGE/GIF"
    CASE "ICO"         : sMimeType = "IMAGE/X-ICON"
    CASE "JPG", "JPEG" : sMimeType = "IMAGE/JPEG"
    CASE "PNG":        : sMimeType = "IMAGE/PNG"
    CASE "TIF", "TIFF" : sMimeType = "IMAGE/TIFF"
    CASE "WMF"         : sMimeType = "IMAGE/X-WMF"
    CASE ELSE          : EXIT FUNCTION
  END SELECT

  GdipGetImageEncodersSize numEncoders, nSize
  IF nSize = 0 THEN EXIT FUNCTION

  DIM buffer(nSize - 1) AS LOCAL BYTE

  pImageCodecInfo = VARPTR(buffer(0))
  IF GdipGetImageEncoders(numEncoders, nSize, pImageCodecInfo) <> 0 THEN EXIT FUNCTION

  WHILE numEncoders > 0
    Tmp = fReadUnicodeString(@pImageCodecInfo.MimeType)
    IF INSTR(UCASE$(Tmp),sMimeType) THEN
      Tmp = GUIDTXT$(@pImageCodecInfo.ClassID)
      sEncoderClsid = GUID$(Tmp)
      EXIT LOOP
    END IF
    DECR numEncoders
    IF numEncoders = 0 THEN EXIT FUNCTION
    INCR pImageCodecInfo
  WEND

  FileSpec = UCODE$(FileSpec)
  img      = hBMP
  GdipCreateBitmapFromHBITMAP hBMP, BYVAL %NULL, img
  nStatus = GdipSaveImageToFile(img, FileSpec, sEncoderClsid)
  GdipDisposeImage img

  FUNCTION = nStatus

END FUNCTION