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

GDI+ Image save/load from/to buffer

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

  • PBWin/PBCC GDI+ Image save/load from/to buffer

    The kind of problem which this code tries to address seems to come up here fairly regularly. This code attempt to provide ultimate flexibility in loading and saving images by performing no in/out (file or resource) internally, instead requiring the caller to perform these functions via memory buffer.

    Includes a demo program which is a crude image format converter.

    Code:
    '------------------------------------------------------------------------------
    ' PowerBASIC "universal" functions to decode a memory-buffered image file
    ' to a PB bitmap, and to encode a PB bitmap to a memory-buffered image file
    '------------------------------------------------------------------------------
    '           Input formats: EMF, WMF, BMP, JPG, PNG, GIF, TIF, ICO
    '               Output formats: WMF, BMP, JPG, PNG, GIF, TIF
    '------------------------------------------------------------------------------
    ' Requires PB/Win 8+                     Laurence Jackson, 2011. Public Domain
    '------------------------------------------------------------------------------
    '
    ' Note: ANSI strings are used as byte array buffers. When including in unicode
    ' enabled applications, ensure that string parameters and return values for
    ' these functions are explicitly specified as non-unicode.
    '
    ' In general, uses GDI+ API functions to perform the decoding and encoding,
    ' but PB functions to create WMF and BMP file images directly from the
    ' bitmap data are included here (these functions are accessed through
    ' and support the universal encoding function).
    '
    ' Uses a memory-buffered file image for input and output (shifting the
    ' responsibility for reading and writing the file to the caller) for
    ' flexibility of source and destination without requiring separate
    ' functions for different applications. The image file to be decoded
    ' can be from disk, the program's resource, or from within another
    ' container file, such as a database or a ZIP archive. Likewise for
    ' encoder output.
    '
    ' Uses a PB bitmap handle for output and input as a readily-accessible
    ' bitmap format for PB programs.
    '
    ' To keep compatibility with PB/Win 8, avoids use of the built-in GLOBALMEM
    ' statements introduced with PB/Win 9 (uses API calls instead). The bitmap
    ' scale mode is specified separately with an API call, rather than using the
    ' built-in parameter to GRAPHIC STRETCH of PB/Win 9. The declaration of the
    ' iStream interface uses PB/Win 8 syntax which is still accepted by later
    ' versions. The ordering of the functions within the source file is compatible
    ' with PB/Win 8 which does not recognize forward references.
    '
    '------------------------------------------------------------------------------
    
    interface dispatch iStream 'Minimal declaration of the iStream interface just
                        'for our purposes here. If the wider program includes the
    end interface            'full declaration elsewhere, may need to remove this
    
    %NULL = 0
    %FALSE = 0
    %TRUE = 1
    %GMEM_MOVEABLE = 2
    
    declare function GlobalMemAlloc_ lib "KERNEL32.DLL" ___________________________
              alias "GlobalAlloc"                 (byval wFlags as dword,         _
                                                  byval dwBytes as dword          _
                                                              ) as long
    
    declare function GlobalMemFree_ lib "KERNEL32.DLL" ____________________________
              alias "GlobalFree"                    (byval hMem as dword          _
                                                              ) as long
    
    declare function GlobalMemSize_ lib "KERNEL32.DLL" ____________________________
              alias "GlobalSize"                    (byval hMem as dword          _
                                                              ) as dword
    
    declare function GlobalMemLock_ lib "KERNEL32.DLL" ____________________________
              alias "GlobalLock"                    (byval hMem as dword          _
                                                              ) as dword
    
    declare function GlobalMemUnlock_ lib "KERNEL32.DLL" __________________________
              alias "GlobalUnlock"                  (byval hMem as dword          _
                                                              ) as long
    
    ' GDI32
    
    %MM_TEXT                = 1
    %HALFTONE               = 4
    %SRCCOPY                = &H00CC0020
    %META_SETMAPMODE        = &H0103
    %META_SETWINDOWORG      = &H020B
    %META_SETWINDOWEXT      = &H020C
    %META_SAVEDC            = &H001E
    %META_SETSTRETCHBLTMODE = &H0107
    %META_DIBSTRETCHBLT     = &H0B41
    %META_RESTOREDC         = &H0127
    
    type RGBQUAD_ byte
      rgbBlue as byte
      rgbGreen as byte
      rgbRed as byte
      rgbReserved as byte
    end type
    
    type BITMAPINFOHEADER_ dword fill
      biSize as dword
      biWidth as long
      biHeight as long
      biPlanes as word
      biBitCount as word
      biCompression as dword
      biSizeImage as dword
      biXPelsPerMeter as long
      biYPelsPerMeter as long
      biClrUsed as dword
      biClrImportant as dword
    end type
    
    type BITMAPINFO_ dword
      bmiHeader as BITMAPINFOHEADER_
      bmiColors(0) as RGBQUAD_
    end type
    
    type BITMAPFILEHEADER_ word
      bfType as word
      bfSize as dword
      bfReserved1 as word
      bfReserved2 as word
      bfOffBits as dword
    end type
    
    declare function SetStretchBltMode_ lib "GDI32.DLL" ___________________________
              alias "SetStretchBltMode"              (byval hdc as dword,         _
                                             byval nStretchMode as long           _
                                                              ) as long
    
    ' GDI+
    
    type IMAGECODECINFO_ dword
      Clsid as guid
      FormatID as guid
      CodecName as word ptr         'wide character ptr
      DllName as word ptr           'wide character ptr
      FormatDescription as word ptr 'wide character ptr
      FilenameExtension as word ptr 'wide character ptr
      MimeType as word ptr          'wide character ptr
      Flags as dword
      Version as dword
      SigCount as dword
      SigSize as dword
      SigPattern as byte ptr
      SigMask as byte ptr
    end type
    
    type ENCODERPARAMETER_ dword
      pGuid as guid
      NumberOfValues as dword
      dwType as dword
      Value as dword
    end type
    
    type ENCODERPARAMETERS_ dword
      Count as dword
      Parameter(0) as ENCODERPARAMETER_
    end type
    
    type GDIPLUSSTARTUPINPUT_ dword
      GdiplusVersion as dword
      DebugEventCallback as dword
      SuppressBackgroundThread as long
      SuppressExternalCodecs as long
    end type
    
    type GDIPLUSSTARTUPOUTPUT_ dword
      NotificationHook as dword
      NotificationUnhook as dword
    end type
    
    declare function GdiplusStartup_ lib "GDIPLUS.DLL" ____________________________
              alias "GdiplusStartup"        (byref token as dword,                _
                                        byref StartInput as GDIPLUSSTARTUPINPUT_, _
                                       byref StartOutput as GDIPLUSSTARTUPOUTPUT_ _
                                                       ) as long
    
    declare sub GdiplusShutdown_ lib "GDIPLUS.DLL" ________________________________
         alias "GdiplusShutdown"                    (byval token as dword         _
                                                              )
    
    declare function GdipGetImageDecodersSize_ lib "GDIPLUS.DLL" __________________
              alias "GdipGetImageDecodersSize"   (byref numDecoders as dword,     _
                                                         byref size as dword      _
                                                                  ) as long
    
    declare function GdipGetImageDecoders_ lib "GDIPLUS.DLL" ______________________
              alias "GdipGetImageDecoders"   (byval numDecoders as dword,         _
                                                     byval size as dword,         _
                                                 byref decoders as any            _
                                                              ) as long
    
    declare function GdipGetImageWidth_ lib "GDIPLUS.DLL" _________________________
              alias "GdipGetImageWidth"            (byval image as dword,         _
                                               byref PixelWidth as dword          _
                                                              ) as long
    
    declare function GdipGetImageHeight_ lib "GDIPLUS.DLL" ________________________
              alias "GdipGetImageHeight"           (byval image as dword,         _
                                              byref PixelHeight as dword          _
                                                              ) as long
    
    declare function GdipCreateFromHDC_ lib "GDIPLUS.DLL" _________________________
              alias "GdipCreateFromHDC"              (byval hdc as dword,         _
                                                 byref graphics as dword          _
                                                              ) as long
    
    declare function GdipDisposeImage_ lib "GDIPLUS.DLL" __________________________
              alias "GdipDisposeImage"             (byval image as dword          _
                                                              ) as long
    
    declare function GdipDrawImageRectI_ lib "GDIPLUS.DLL" ________________________
              alias "GdipDrawImageRectI"        (byval graphics as dword,         _
                                                    byval image as dword,         _
                                                        byval x as long,          _
                                                        byval y as long,          _
                                               byval PixelWidth as long,          _
                                              byval PixelHeight as long           _
                                                              ) as long
    
    declare function GdipDeleteGraphics_ lib "GDIPLUS.DLL" ________________________
              alias "GdipDeleteGraphics"        (byval graphics as dword          _
                                                              ) as long
    
    declare function GdipGetImageEncodersSize_ lib "GDIPLUS.DLL" __________________
              alias "GdipGetImageEncodersSize" (byref numEncoders as dword,       _
                                                       byref size as dword        _
                                                                ) as long
    
    declare function GdipGetImageEncoders_ lib "GDIPLUS.DLL" ______________________
              alias "GdipGetImageEncoders"   (byval numEncoders as dword,         _
                                                     byval size as dword,         _
                                                 byref encoders as any            _
                                                              ) as long
    
    declare function GdipCreateBitmapFromGdiDib_ lib "GDIPLUS.DLL" ________________
              alias "GdipCreateBitmapFromGdiDib"     (byref bmi as BITMAPINFO_,   _
                                                      byval bmd as dword,         _
                                                    byref btmap as dword          _
                                                              ) as long
    
    declare function GdipCreateBitmapFromStream_ lib "GDIPLUS.DLL" ________________
              alias "GdipCreateBitmapFromStream"  (byval stream as iStream,       _
                                                    byref btmap as dword          _
                                                              ) as long
    
    declare function GdipSaveImageToStream_ lib "GDIPLUS.DLL" _____________________
              alias "GdipSaveImageToStream"    (byval image as dword,             _
                                               byval stream as iStream,           _
                                         byref clsidEncoder as guid,              _
                                        byref encoderParams as ENCODERPARAMETERS_ _
                                                          ) as long
    
    ' OLE32
    
    declare function CreateStreamOnHGlobal_ lib "OLE32.DLL" _______________________
              alias "CreateStreamOnHGlobal"      (byval hGlobal as dword,         _
                                         byval fDeleteOnRelease as long,          _
                                                    byref ppstm as iStream        _
                                                              ) as long
    
    declare function GetHGlobalFromStream_ lib "OLE32.DLL" ________________________
              alias "GetHGlobalFromStream"          (byval pstm as iStream,       _
                                                 byref phglobal as dword          _
                                                              ) as long
    
    
    function BitmapStringToBMP ____________________________________________________
                                                      (stBitmap as string         _
                                                              ) as string
    '------------------------------------------------------------------------------
    '
    ' Replaces the PB header with a BMP header on a PB bitmap string and returns
    ' the result (which can be dumped to disk directly if a BMP file is required).
    '
    ' The received bitmap data string is as received from the GRAPHIC GET BITS
    ' statement, with a two-dword header which specifies the width and height.
    ' The data is expected to be a 32-bits-per-pixel top-down map (again, as
    ' returned by the GRAPHIC GET BITS statement). If the input string is not
    ' of the expected size for the width and height it specifies, a null string
    ' is returned. The input buffer is returned unaltered.
    '
    ' The BMP header is in two parts: the BITMAPFILEHEADER (14 bytes) and the
    ' BitmapInfoHeader (40 bytes). If the BITMAPFILEHEADER is removed, the
    ' result is a DIB which is accepted for input by GDI+. Thus:
    '
    ' Start of DIB: Byte 15
    ' Start of pixel data: Byte 55
    '
    ' The bitmap data is currently written into the BMP unmodified. However,
    ' separating out the generation of this precursor to all the output
    ' formats into a separate function gives the potential to reduce the
    ' data size if the input is not a full 32-bit color bitmap.
    '
    ' If any kind of optimization is performed in the future, the location
    ' of the start of the pixel data (but not the start of the DIB header)
    ' will change.
    '
    '------------------------------------------------------------------------------
    
    local ptBFH as BITMAPFILEHEADER_ ptr
    local ptBIH as BITMAPINFOHEADER_ ptr
    local pBuffer as byte ptr
    local stBuffer as string
    local lgWidth as long
    local lgHeight as long
    local lgImageByteSize as long
    
    if len(stBitmap) < 8 then exit function
    lgWidth = cvdwd(stBitmap)
    lgHeight = cvdwd(mid$(stBitmap, 5, 4))
    lgImageByteSize = lgWidth * lgHeight * 4
    if lgImageByteSize < 4 then exit function
    if lgImageByteSize <> (len(stBitmap) - 8) then exit function
    stBuffer = string$(lgImageByteSize + 54, $NUL)
    
    ptBFH = strptr(stBuffer)
    @ptBFH.bfType = cvwrd("BM")
    @ptBFH.bfSize = lgImageByteSize + sizeof(BITMAPFILEHEADER_) + sizeof(BITMAPINFOHEADER_)
    @ptBFH.bfReserved1 = 0
    @ptBFH.bfReserved2 = 0
    @ptBFH.bfOffBits = sizeof(BITMAPINFOHEADER_)
    
    ptBIH = ptBFH + sizeof(BITMAPFILEHEADER_)
    @ptBIH.biSize = sizeof(BITMAPINFOHEADER_)
    @ptBIH.biWidth = lgWidth
    @ptBIH.biHeight = -lgHeight '-ve for top-down
    @ptBIH.biPlanes = 1
    @ptBIH.biBitCount = 32
    @ptBIH.biCompression = 0 'None
    @ptBIH.biSizeImage = lgImageByteSize
    @ptBIH.biXPelsPerMeter = 0
    @ptBIH.biYPelsPerMeter = 0
    @ptBIH.biClrUsed = 0
    @ptBIH.biClrImportant = 0
    
    pBuffer = ptBIH + sizeof(BITMAPINFOHEADER_)
    poke$ pBuffer, mid$(stBitmap, 9)
    function = stBuffer
    
    end function
    
    
    function BitmapStringToWMF ____________________________________________________
                                                (stBitmapString as string         _
                                                              ) as string
    '------------------------------------------------------------------------------
    '
    ' There are Windows API functions for creating metafiles, but they are
    ' inefficient and difficult to use for simple bitmaps. This function
    ' builds a simple WMF containing a single bitmap directly.
    '
    ' The received bitmap data string is as received from the GRAPHIC GET
    ' BITS statement.
    '
    ' The result of the function is a buffer containing the file contents
    ' which may be simply dumped to disk by the caller to create the WMF.
    '
    ' A similar function could be created for EMF, but the author has no
    ' use for EMF files at this time!
    '
    '------------------------------------------------------------------------------
    
    local stBitmap as string
    local lgWidth as long
    local lgHeight as long
    local lgImageByteSize as long
    local lgMapRecWordSize as long
    local lgFileWordSize as long
    local stBuffer as string
    local pBuffer as byte ptr
    
    if len(stBitmapString) < 8 then exit function
    lgWidth = cvdwd(stBitmapString)
    lgHeight = cvdwd(mid$(stBitmapString, 5, 4))
    
    stBitmap = BitmapStringToBMP(stBitmapString)
    if stBitmap = "" then exit function
    lgImageByteSize = len(stBitmap) - 54
    
    lgMapRecWordSize = (lgImageByteSize \ 2) + 13 + 20
    lgFileWordSize = lgMapRecWordSize + 37
    stBuffer = string$(lgFileWordSize * 2, $NUL)
    pBuffer = strptr(stBuffer)
    
    ' Header
    
    poke$ pBuffer, mki$(1): pBuffer = pBuffer + 2                'WMF type
    poke$ pBuffer, mki$(9): pBuffer = pBuffer + 2             'Header size
    poke$ pBuffer, mki$(&H0300): pBuffer = pBuffer + 2      'Version (3.0)
    poke$ pBuffer, mkl$(lgFileWordSize): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2   'Number of objects (0)
    poke$ pBuffer, mkl$(lgMapRecWordSize): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2   'Num of parameters (0)
    
    ' Record 1
    
    poke$ pBuffer, mkl$(4): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(%META_SETMAPMODE): pBuffer = pBuffer + 2
    poke$ pBuffer, mki$(%MM_TEXT): pBuffer = pBuffer + 2
    
    ' Record 2
    
    poke$ pBuffer, mkl$(5): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(%META_SETWINDOWORG): pBuffer = pBuffer + 2
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2                'Y origin
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2                'X origin
    
    ' Record 3
    
    poke$ pBuffer, mkl$(5): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(%META_SETWINDOWEXT): pBuffer = pBuffer + 2
    poke$ pBuffer, mki$(lgHeight): pBuffer = pBuffer + 2
    poke$ pBuffer, mki$(lgWidth): pBuffer = pBuffer + 2
    
    ' Record 4
    
    poke$ pBuffer, mkl$(3): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(%META_SAVEDC): pBuffer = pBuffer + 2
    
    ' Record 5
    
    poke$ pBuffer, mkl$(4): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(%META_SETSTRETCHBLTMODE): pBuffer = pBuffer + 2
    poke$ pBuffer, mki$(%HALFTONE): pBuffer = pBuffer + 2
    
    ' Record 6
    
    poke$ pBuffer, mkl$(lgMapRecWordSize): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(%META_DIBSTRETCHBLT): pBuffer = pBuffer + 2
    poke$ pBuffer, mkl$(%SRCCOPY): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(lgHeight): pBuffer = pBuffer + 2    'Source height
    poke$ pBuffer, mki$(lgWidth): pBuffer = pBuffer + 2      'Source width
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2                'Source Y
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2                'Source X
    poke$ pBuffer, mki$(lgHeight): pBuffer = pBuffer + 2      'Dest height
    poke$ pBuffer, mki$(lgWidth): pBuffer = pBuffer + 2        'Dest width
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2                  'Dest Y
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2                  'Dest X
    poke$ pBuffer, mid$(stBitmap, 15): pBuffer = pBuffer + (len(stBitmap) - 14)
    
    ' Record 7
    
    poke$ pBuffer, mkl$(4): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(%META_RESTOREDC): pBuffer = pBuffer + 2
    poke$ pBuffer, mki$(-1): pBuffer = pBuffer + 2
    
    ' Record 8
    
    poke$ pBuffer, mkl$(3): pBuffer = pBuffer + 4
    poke$ pBuffer, mki$(0): pBuffer = pBuffer + 2              'Terminator
    
    function = stBuffer
    
    end function
    
    
    function ImageToBitmap ________________________________________________________
                                              (stFileData as string,              _
                                                 lgPixelW as long,                _
                                                 lgPixelH as long                 _
                                                        ) as dword
    '------------------------------------------------------------------------------
    '
    ' Converts an image file in memory to a bitmap in memory and returns its
    ' handle for manipulation and display of the image using the PB GRAPHIC
    ' statements. The bitmap may be optionally scaled on loading.
    '
    ' Receives a file data buffer.
    '
    ' Receives optional size limits or specifications.
    '
    ' Returns a PB bitmap handle and the returned size of the bitmap.
    '
    ' The stFileData input string should contain the raw binary data of the
    ' image, for example, loaded from file using something like:
    '
    '  open "Image.jpg" for binary as #1
    '  stFileData = string$(lof(1), 0)
    '  get #1,,stFileData
    '  close #1
    '  hBitmap = ImageToBitmap(stFileData, lgPixelW, lgPixelH)
    '
    ' If both the lgPixelW and the lgPixelH parameters are passed as zero,
    ' then the bitmap is loaded with the same pixel width and height as the
    ' source. This size is returned in the lgPixelW and lgPixelH parameters.
    '
    ' If one of the lgPixelW or lgPixelH parameters is passed as zero, then
    ' the bitmap is scaled to the width or height specified by the non-zero
    ' parameter. Aspect ratio is preserved and the zero parameter is filled
    ' in with the scaled width or height on return.
    '
    ' If the specified width or height is negative, the absolute value is
    ' treated as a maximum value. That is, the image may be scaled down,
    ' preserving the aspect ratio, but is never scaled up.
    '
    ' If both the lgPixelW or lgPixelH parameters are specified, then the
    ' bitmap is scaled to the specified size, ignoring the source aspect ratio.
    ' The returned lgPixelW and lgPixelH values will be the same as on entry.
    '
    ' If both width and height are specified and one or both of them is
    ' negative, the absolute values are treated as maximum values. That
    ' is, the image may be scaled down, preserving the aspect ratio, but
    ' is never scaled up.
    '
    ' The stFileData contents are returned as received. The function
    ' result is zero if there is some error.
    '
    ' The format of the image passed is determined automatically from the
    ' signature found in the input buffer. If you wish to know the image
    ' formats which can be decoded by the installed version of GDI+, see
    ' the next paragraph.
    '
    ' Special feature:
    ' If the stFileData parameter is passed as a null string, the returned 
    ' string is not a file data buffer but an enumerated list of the decoder 
    ' types available. The list is in the form of a sequence of strings in 
    ' the format "*.ext" separated by semicolons. The return value is zero
    ' (a bitmap is not created). The returned string can be used directly
    ' for an Open File dialog.
    '
    '------------------------------------------------------------------------------
    
    local Stream as iStream
    local ptCodecInfo as IMAGECODECINFO_ ptr
    local tStartupInput as GDIPLUSSTARTUPINPUT_
    local dwToken as dword
    local dcGraphic as dword
    local dwFileSize as dword
    local pFileData as byte ptr
    local hGlobalMem as dword
    local pGlobalMem as byte ptr
    local hImage as dword
    local lgStatus as long
    local lgResult as long
    local hGraphic as dword
    local lgWidth as long
    local lgHeight as long
    local hBitmap1 as dword
    local hBitmap2 as dword
    local dwEncoderCount as dword
    local dwEncInfoSize as dword
    local stImageCodecInfo as string
    local lgIndex as long
    local pwdEndMark as word ptr
    local lgLength as long
    local stFileExt as string
    local lgMark as long
    local lgNoScaleUp as long
    local hDC as dword
    
    ' If an empty file buffer was passed, fill it with a list of
    ' supported decoder formats and exit.
    
    if stFileData = "" then
      tStartupInput.GDIplusVersion = 1
      if GDIplusStartup_(dwToken, tStartupInput, byval %NULL) <> 0 then
        exit function
      end if
      GdipGetImageDecodersSize_ dwEncoderCount, dwEncInfoSize
      stImageCodecInfo = string$(dwEncInfoSize, $NUL)
      ptCodecInfo = strptr(stImageCodecInfo)
      lgResult = GdipGetImageDecoders_(dwEncoderCount, dwEncInfoSize, byval ptCodecInfo)
      if lgResult then
        GDIplusShutdown_ dwToken
        exit function
      end if
      for lgIndex = 1 to dwEncoderCount
        pwdEndMark = @ptCodecInfo.FilenameExtension
        lgLength = 0
        do while @pwdEndMark <> %NULL
          incr pwdEndMark
          lgLength = lgLength + 2
        loop
        stFileExt = acode$(peek$(@ptCodecInfo.FilenameExtension, lgLength))
        lgMark = instr(stFileExt, ";")
        if lgMark then stFileExt = left$(stFileExt, lgMark - 1)
        stFileData = stFileData + ";" + stFileExt
        incr ptCodecInfo
        stFileExt = ""
      next lgIndex
      GDIplusShutdown_ dwToken
      stFileData = lcase$(mid$(stFileData, 2))
      exit function
    end if
    
    ' Make a pointer to the file data and get its size
    
    dwFileSize = len(stFileData)
    pFileData = strptr(stFileData)
    
    ' Allocate global memory
    
    hGlobalMem = GlobalMemAlloc_(%GMEM_MOVEABLE, dwFileSize)
    if hGlobalMem = 0 then
      exit function
    end if
    
    ' Lock the global memory location and get a pointer
    
    pGlobalMem = GlobalMemLock_(hGlobalMem)
    if pGlobalMem = 0 then
      lgResult = GlobalMemFree_(hGlobalMem)
      exit function
    end if
    
    ' Copy the file data into the the global memory
    
    poke$ pGlobalMem, peek$(pFileData, dwFileSize)
    
    ' Create a stream from the file in global memory
    
    lgResult = CreateStreamOnHGlobal_(hGlobalMem, byval %FALSE, Stream)
    if lgResult <> 0 then
      lgResult = GlobalMemUnlock_(hGlobalMem)
      lgResult = GlobalMemFree_(hGlobalMem)
      exit function
    end if
    
    ' Start GDI+
    
    tStartupInput.GDIplusVersion = 1
    if GDIplusStartup_(dwToken, tStartupInput, byval %NULL) <> 0 then
      function = 0
      exit function
    end if
    
    ' Create a GDI+ bitmap from the memory file stream
    ' Caution: Even though GDI+ appears to be finished with
    ' the global memory stream, it cannot be freed yet.
    
    lgStatus = GdipCreateBitmapFromStream_(Stream, hImage)
    if hImage = 0 then
      GDIplusShutdown_ dwToken
      Stream = nothing
      lgResult = GlobalMemUnlock_(hGlobalMem)
      lgResult = GlobalMemFree_(hGlobalMem)
      exit function
    end if
    
    ' Get the image width and height and create a new PB bitmap
    
    GdipGetImageWidth_  hImage, lgWidth
    GdipGetImageHeight_ hImage, lgHeight
    graphic bitmap new lgWidth, lgHeight to hBitmap1
    graphic attach hBitmap1, 0
    
    ' Create a GDI+ handle for the new PB bitmap
    
    graphic get DC to dcGraphic
    GdipCreateFromHDC_ dcGraphic, hGraphic
    if hGraphic = 0 then
      graphic bitmap end
      GdipDisposeImage_ hImage
      GDIplusShutdown_ dwToken
      Stream = nothing
      lgResult = GlobalMemUnlock_(hGlobalMem)
      lgResult = GlobalMemFree_(hGlobalMem)
      exit function
    end if
    
    ' Copy the GDI+ bitmap into the PB bitmap
    
    GdipDrawImageRectI_ hGraphic, hImage, 0, 0, lgWidth, lgHeight
    
    ' The image data is now in the PB bitmap area so GDI+
    ' can be shut down and the global memory freed.
    
    GdipDeleteGraphics_ hGraphic
    GdipDisposeImage_ hImage
    GDIplusShutdown_ dwToken
    Stream = nothing
    lgResult = GlobalMemUnlock_(hGlobalMem)
    lgResult = GlobalMemFree_(hGlobalMem)
    
    ' Set the scaled image width and height. If no scaling
    ' is specified, or if the specified width and height
    ' match the loaded width and height, exit here.
    
    if lgPixelW < 0 then
      lgPixelW = abs(lgPixelW)
      lgNoScaleUp = %TRUE
    end if
    if lgPixelH < 0 then
      lgPixelH = abs(lgPixelH)
      lgNoScaleUp = %TRUE
    end if
    
    if (lgPixelW = 0) and (lgPixelH = 0) then
      lgPixelW = lgWidth
      lgPixelH = lgHeight
      function = hBitmap1
      exit function
    elseif lgPixelH = 0 then 'Width specified:
      if lgNoScaleUp then 'Max width specified:
        if lgWidth > lgPixelW then
          lgPixelH = lgHeight * (lgPixelW / lgWidth)
        else
          lgPixelW = lgWidth
          lgPixelH = lgHeight
        end if
      else
      end if
    elseif lgPixelW = 0 then 'Height specified:
      if lgNoScaleUp then 'Max height specified:
        if lgHeight > lgPixelH then
          lgPixelW = lgWidth * (lgPixelH / lgHeight)
        else
          lgPixelW = lgWidth
          lgPixelH = lgHeight
        end if
      else
        lgPixelW = lgWidth * (lgPixelH / lgHeight)
      end if
    elseif lgNoScaleUp then 'Max width and height specified:
      if lgHeight > lgPixelH then
        lgPixelW = lgWidth * (lgPixelH / lgHeight)
        if lgWidth > lgPixelW then
          lgPixelH = lgHeight * (lgPixelW / lgWidth)
        end if
      elseif lgWidth > lgPixelW then
        lgPixelH = lgHeight * (lgPixelW / lgWidth)
      else
        lgPixelW = lgWidth
        lgPixelH = lgHeight
      end if
    end if
    if (lgPixelW = lgWidth) and (lgPixelH = lgHeight) then
      function = hBitmap1
      exit function
    end if
    
    ' Scale the image, if required, and exit
    
    graphic bitmap new lgPixelW, lgPixelH to hBitmap2
    graphic attach hBitmap2, 0
    graphic get DC to hDC
    SetStretchBltMode_ hDC, %HALFTONE
    graphic stretch hBitmap1, 0, (0, 0) - (lgWidth, lgHeight) _
      to (0, 0) - (lgPixelW, lgPixelH), %MIX_COPYSRC
    graphic attach hBitmap1, 0
    graphic bitmap end
    function = hBitmap2
    
    end function
    
    
    function BitmapToImage ________________________________________________________
                                                       (hBitmap as dword,         _
                                                    stImageType as string         _
                                                              ) as string
    '------------------------------------------------------------------------------
    '
    ' Converts a PB bitmap in memory to an image file in memory.
    '
    ' Receives a PB bitmap handle (hBitmap).
    '
    ' Receives an image file format specification (stImageType).
    '
    ' Returns a string buffer containing the image file contents.
    '
    ' The returned buffer string contains the raw binary data of the image.
    ' It can be saved as image file, for example, using something like:
    '
    ' stFileBuffer = BitmapToImage(hBitmap, "jpg")
    ' open "Image.jpg" for output as #1
    ' print #1, stFileBuffer;
    ' close #1
    '
    ' The stImageType parameter may be in any case and in the form of a recognized
    ' filename extension (which may be one of the lesser-used extensions) or a
    ' MIME type. On output, if the conversion is successful, the stImageType
    ' parameter will contain the primary filename extension of the requested
    ' format in lower case, corresponding to, but irrespective of, the form
    ' of the input.
    '
    ' Special feature:
    ' If the stImageType parameter is passed as a null string, or if the hBitmap
    ' is parameter is null, the returned string in not a file data buffer but an
    ' enumerated list of the encoder types available in the version of GDI+ which
    ' is installed. The list is in the form of a sequence of strings in the format
    ' "*.ext" separated by semicolons. The returned string can be used directly
    ' for a Save As dialog.
    '
    '-------------------------------------------------------------------------------
    
    local ptCodecInfo as IMAGECODECINFO_ ptr
    local tStartupInput as GDIPLUSSTARTUPINPUT_
    local dwToken as dword
    local guidEncoder as guid
    local stBitmap as string
    local pHeader as byte ptr
    local pBitmap as byte ptr
    local dwFileSize as dword
    local hGlobalMem as dword
    local pGlobalMem as byte ptr
    local lgResult as long
    local hImage as dword
    local Stream as iStream
    local stMimeType as string
    local dwEncoderCount as dword
    local dwEncInfoSize as dword
    local stImageCodecInfo as string
    local lgIndex as long
    local pwdEndMark as word ptr
    local lgLength as long
    local stFileExt as string
    local lgMark as long
    local lgListEncoders as long
    local stFileTypes as string
    
    ' Check the input parameters
    
    if hBitmap = 0 then
      lgListEncoders = %TRUE
    elseif stImageType = "" then
      lgListEncoders = %TRUE
    elseif len(stImageType) < 3 then
      exit function
    elseif lcase$(stImageType) = "wmf" _
        or lcase$(stImageType) = "image/wmf" _
        or lcase$(stImageType) = "image/x-wmf" then
      graphic attach hBitmap, 0
      graphic get bits to stBitmap
      function = BitmapStringToWMF(stBitmap)
      exit function
    end if
    
    ' Start GDI+
    
    tStartupInput.GDIplusVersion = 1
    if GDIplusStartup_(dwToken, tStartupInput, byval %NULL) <> 0 then
      exit function
    end if
    
    ' Get the required encoder GUID from the specified
    ' MIME type or file extension
    
    GdipGetImageEncodersSize_ dwEncoderCount, dwEncInfoSize
    stImageCodecInfo = string$(dwEncInfoSize, $NUL)
    ptCodecInfo = strptr(stImageCodecInfo)
    lgResult = GdipGetImageEncoders_(dwEncoderCount, dwEncInfoSize, byval ptCodecInfo)
    if lgResult then
      GDIplusShutdown_ dwToken
      exit function
    end if
    for lgIndex = 1 to dwEncoderCount
      pwdEndMark = @ptCodecInfo.MimeType
      lgLength = 0
      do while @pwdEndMark <> %NULL
        incr pwdEndMark
        lgLength = lgLength + 2
      loop
      stMimeType = acode$(peek$(@ptCodecInfo.MimeType, lgLength))
      pwdEndMark = @ptCodecInfo.FilenameExtension
      lgLength = 0
      do while @pwdEndMark <> %NULL
        incr pwdEndMark
        lgLength = lgLength + 2
      loop
      stFileExt = acode$(peek$(@ptCodecInfo.FilenameExtension, lgLength))
      lgMark = instr(stFileExt, ";")
      if lgMark then stFileExt = left$(stFileExt, lgMark - 1)
      if lgListEncoders then
        stFileTypes = stFileTypes + ";" + stFileExt
      else
        if instr(lcase$(stMimeType), lcase$(stImageType)) then
          guidEncoder = @ptCodecInfo.Clsid
          stFileExt = lcase$(mid$(stFileExt, 3))
          exit for
        elseif instr(lcase$(stFileExt), lcase$(stImageType)) then
          guidEncoder = @ptCodecInfo.Clsid
          stFileExt = lcase$(mid$(stFileExt, 3))
          exit for
        end if
      end if
      incr ptCodecInfo
      stFileExt = ""
      stMimeType = ""
    next lgIndex
    if lgListEncoders then
      GDIplusShutdown_ dwToken
      stFileTypes = stFileTypes + ";*.wmf"
      function = lcase$(mid$(stFileTypes, 2))
      exit function
    elseif stMimeType = "" then
      GDIplusShutdown_ dwToken
      exit function
    end if
    
    ' Copy the bitmap data into a string which contains Width
    ' as long, Height as long, followed by the top-down
    ' uncompressed bitmap data as 4 bytes per pixel.
    
    graphic attach hBitmap, 0
    graphic get bits to stBitmap
    
    ' Convert the PB bitmap string to a BMP file in memory
    
    stBitmap = BitmapStringToBMP(stBitmap)
    if (stFileExt = "bmp") or (stBitmap = "") then
      function = stBitmap
      GDIplusShutdown_ dwToken
      exit function
    end if
    
    ' Create a GDI+ bitmap from the DIB header and the bitmap data.
    
    pHeader = strptr(stBitmap) + 14
    pBitmap = strptr(stBitmap) + 54
    lgResult = GdipCreateBitmapFromGdiDib_ (byval pHeader, pBitmap, hImage)
    if hImage = 0 then
      lgResult = GlobalMemUnlock_(hGlobalMem)
      lgResult = GlobalMemFree_(hGlobalMem)
      GDIplusShutdown_ dwToken
      exit function
    end if
    
    ' Create a stream for output and save the GDI+ bitmap in
    ' the requested format to it.
    
    lgResult = CreateStreamOnHGlobal_(%NULL, %FALSE, Stream)
    if lgResult <> 0 then
      GdipDisposeImage_ hImage
      GDIplusShutdown_ dwToken
      exit function
    end if
    
    lgResult = GdipSaveImageToStream_(hImage, Stream, guidEncoder, byval %NULL)
    if lgResult <> 0 then
      exit function
    end if
    
    ' Get the global handle of the output stream. Lock the global memory
    ' location and get a pointer. Get the global memory size.
    
    GetHGlobalFromStream_ Stream, hGlobalMem
    if hGlobalMem = 0 then
      GdipDisposeImage_ hImage
      GDIplusShutdown_ dwToken
      exit function
    end if
    
    dwFileSize = GlobalMemSize_(hGlobalMem)
    if dwFileSize = 0 then
      lgResult = GlobalMemFree_(hGlobalMem)
      GdipDisposeImage_ hImage
      GDIplusShutdown_ dwToken
      exit function
    end if
    
    pGlobalMem = GlobalMemLock_(hGlobalMem)
    if pGlobalMem = 0 then
      lgResult = GlobalMemUnlock_(hGlobalMem)
      lgResult = GlobalMemFree_(hGlobalMem)
      GdipDisposeImage_ hImage
      GDIplusShutdown_ dwToken
      exit function
    end if
    
    ' Get the size of the global memory block and
    ' copy the block to the output string.
    
    dwFileSize = GlobalMemSize_(hGlobalMem)
    function = peek$(pGlobalMem, dwFileSize)
    
    ' Cleanup
    
    Stream = NOTHING
    lgResult = GlobalMemUnlock_(hGlobalMem)
    lgResult = GlobalMemFree_(hGlobalMem)
    GdipDisposeImage_ hImage
    GDIplusShutdown_ dwToken
    stImageType = stFileExt
    
    end function
    Demo program:
    Code:
    ' ImageDemo.bas                                         Laurence Jackson, 2011
    '------------------------------------------------------------------------------
    ' Demo/testing program for the functions in ImageLib.bas
    ' A simple image format conversion application.
    ' For PB/Win 8, 9, 10 or PB/CC 4, 5, 6.
    '------------------------------------------------------------------------------
    
    #dim all
    #compiler pbcc 4
    #console off
    #include "ImageLib.bas"
    #include "OpenFile.bas"
    #include "SaveFile.bas"
    
    %HWND_DESKTOP = 0
    
    declare function MessageBox_ lib "USER32.DLL" _________________________________
              alias "MessageBoxA"                   (byval hWnd as dword,         _
                                                         lpText as asciiz,        _
                                                      lpCaption as asciiz,        _
                                                   byval dwType as dword          _
                                                              ) as long
    
    declare function SetStretchBltMode_ lib "GDI32.DLL" ___________________________
              alias "SetStretchBltMode"              (byval hdc as dword,         _
                                             byval nStretchMode as long           _
                                                              ) as long
    
    
    function PBMain _______________________________________________________________
                                                             () as long
    '------------------------------------------------------------------------------
    '
    ' As is, will compile with PB/Win 8, 9 and 10 and PB/CC 4, 5 and 6.
    ' If compiling with PB/CC, use "#console off".
    '
    ' If compiling with PB/Win only, the MessageBox API calls can be replaced
    ' with msgbox statements and the declaration above can be deleted.
    '
    ' If compiling with PB/Win 9 or 10 only, calls to DisplayOpenFile and
    ' DisplaySaveFile can be replaced by DISPLAY OPENFILE and DISPLAY SAVEFILE
    ' statements, omitting the position parameters. The "#include OpenSave.bas"
    ' line above can then be deleted.
    '
    '------------------------------------------------------------------------------
    
    local stFileBuffer as string
    local hBitmap as dword
    local lgWidth as long
    local lgHeight as long
    local stFileName as string
    local stImageType as string
    local stDecoderList as string
    local stEncoderList as string
    local hWindow as dword
    local lgClientWidth as long
    local lgClientHeight as long
    local hDC as dword
    local szText as asciiz * 128
    local szTitle as asciiz * 32
    
    szTitle = "ImageLib"
    
    ' Use the facility of ImageToBitmap to return a list of supported
    ' file types to create the "Open File" filter string.
    
    ImageToBitmap stDecoderList, 0, 0
    DisplayOpenFile %HWND_DESKTOP, 0, 0, "Open Image", "", _
      chr$(stDecoderList, 0, stDecoderList, 0), "", "", %OFN_FILEMUSTEXIST _
      to stFileName
    if stFileName = "" then exit function
    
    ' Load the entire file contents as a blob into a buffer string.
    
    open stFileName for binary as #1
    stFileBuffer = string$(lof(1), 0)
    get #1,,stFileBuffer
    close #1
    
    ' Although ImageToBitmap can scale the bitmap for us, we will
    ' load it at natural size by passing zero width and height
    ' parameters and scale it here if necessary so that we can
    ' encode and save the full resolution image.
    
    hBitmap = ImageToBitmap(stFileBuffer, lgWidth, lgHeight)
    if hBitmap = 0 then
      stFileName = mid$(stFileName, instr(-1, stFileName, "\") + 1)
      szText = "Conversion of " + stFileName + " to a bitmap failed"
      MessageBox_ %NULL, szText, szTitle, %NULL
      exit function
    end if
    
    ' Scale the dimensions of a large image for display
    
    desktop get client to lgClientWidth, lgClientHeight
    lgClientWidth = lgClientWidth - 60
    lgClientHeight = lgClientHeight - 60
    if lgHeight > lgClientHeight then
      lgClientWidth = lgWidth * (lgClientHeight / lgHeight)
      if lgWidth > lgClientWidth then
        lgClientHeight = lgHeight * (lgClientWidth / lgWidth)
      end if
    elseif lgWidth > lgClientWidth then
      lgClientHeight = lgHeight * (lgClientWidth / lgWidth)
    else
      lgClientWidth = lgWidth
      lgClientHeight = lgHeight
    end if
    
    ' Display the bitmap in a PB graphic window
    
    graphic window stFileName, 20, 20, lgClientWidth, lgClientHeight to hWindow
    graphic attach hWindow, 0
    graphic get DC to hDC
    SetStretchBltMode_ hDC, %HALFTONE
    graphic stretch hBitmap, 0, (0, 0) - (lgWidth, lgHeight) _
      to (0, 0) - (lgClientWidth, lgClientHeight), %MIX_COPYSRC
    
    ' Use the facility of BitmapToImage to return a list of supported
    ' file types to create the "Save As" filter string.
    
    stEncoderList = BitmapToImage(%NULL, $NUL)
    DisplaySaveFile %HWND_DESKTOP, 0, 0, "Save Image", "", _
      chr$(stEncoderList, 0, stEncoderList, 0), "", "", %OFN_OVERWRITEPROMPT _
      to stFileName
    if stFileName = "" then
      szText = "Saving of the bitmap to a new image file was cancelled"
      MessageBox_ %NULL, szText, szTitle, %NULL
      exit function
    end if
    
    ' Use the extension of the specified file to specify the encoder
    ' to use to BitmapToImage. If an unrecognized, or no, extension
    ' was specified, encoding will fail.
    
    stFileBuffer = ""
    stImageType = mid$(stFileName, instr(-1, stFileName, ".") + 1)
    stFileBuffer = BitmapToImage(hBitmap, stImageType)
    if stFileBuffer = "" then
      szText = "Conversion of the bitmap to a " + stImageType + " image failed"
      MessageBox_ %NULL, szText, szTitle, %NULL
      exit function
    end if
    
    ' Write the entire returned buffer contents as a blob to the file.
    
    open stFileName for output as #1
    print #1, stFileBuffer;
    close #1
    
    szText = "Done"
    MessageBox_ %NULL, szText, szTitle, %NULL
    
    end function
    - LJ

  • #2
    Extra includes required for PB/Win 8 and PB/CC

    Code:
    ' OpenFile.bas                                          Laurence Jackson, 2011
    '------------------------------------------------------------------------------
    ' Open File dialog box for PB/Win 8 or PB/CC, designed for compatibility with
    ' the DISPLAY OPENFILE statement of PB/Win 9+.
    '------------------------------------------------------------------------------
    ' The only difference is that user functions cannot have optional parameters
    ' in the middle of the parameter list, so the X and Y positions cannot be
    ' omitted. A value of zero is used to indicate "centered", do if you really
    ' want the dialog all the way to the top and left, use 1,1.
    '------------------------------------------------------------------------------
    
    #include "FileDlgPos.bas"
    
    %MAX_PATH      = 260
    
    %OFN_READONLY             = &H00000001
    %OFN_OVERWRITEPROMPT      = &H00000002
    %OFN_HIDEREADONLY         = &H00000004
    %OFN_NOCHANGEDIR          = &H00000008
    %OFN_SHOWHELP             = &H00000010
    %OFN_ENABLEHOOK           = &H00000020
    %OFN_ENABLETEMPLATE       = &H00000040
    %OFN_ENABLETEMPLATEHANDLE = &H00000080
    %OFN_NOVALIDATE           = &H00000100
    %OFN_ALLOWMULTISELECT     = &H00000200
    %OFN_EXTENSIONDIFFERENT   = &H00000400
    %OFN_PATHMUSTEXIST        = &H00000800
    %OFN_FILEMUSTEXIST        = &H00001000
    %OFN_CREATEPROMPT         = &H00002000
    %OFN_SHAREAWARE           = &H00004000
    %OFN_NOREADONLYRETURN     = &H00008000
    %OFN_NOTESTFILECREATE     = &H00010000
    %OFN_NONETWORKBUTTON      = &H00020000
    %OFN_NOLONGNAMES          = &H00040000
    %OFN_EXPLORER             = &H00080000
    %OFN_NODEREFERENCELINKS   = &H00100000
    %OFN_LONGNAMES            = &H00200000
    %OFN_ENABLEINCLUDENOTIFY  = &H00400000
    %OFN_ENABLESIZING         = &H00800000
    %OFN_DONTADDTORECENT      = &H02000000
    %OFN_FORCESHOWHIDDEN      = &H10000000
    
    type OPENFILENAME_
      lStructSize as dword
      hWndOwner as dword
      hInstance as dword
      lpstrFilter as asciiz ptr
      lpstrCustomFilter as asciiz ptr
      nMaxCustFilter as dword
      nFilterIndex as dword
      lpstrFile as asciiz ptr
      nMaxFile as dword
      lpstrFileTitle as asciiz ptr
      nMaxFileTitle as dword
      lpstrInitialDir as asciiz ptr
      lpstrTitle as asciiz ptr
      Flags as dword
      nFileOffset as word
      nFileExtension as word
      lpstrDefExt as asciiz ptr
      lCustData as long
      lpfnHook as dword
      lpTemplateName as asciiz ptr
      pvReserved as dword
      dwReserved as dword
      FlagsEx as dword
    end type
    
    declare function GetOpenFileName lib "COMDLG32.DLL" ___________________________
              alias "GetOpenFileNameA"                   (lpofn as OPENFILENAME_   _
                                                              ) as long
    
    function DisplayOpenFile ______________________________________________________
                                                       (hParent as dword,         _
                                                         lgPosX as long,          _
                                                         lgPosY as long,          _
                                                        stTitle as string,        _
                                                       stFolder as string,        _
                                                       stFilter as string,        _
                                                        stStart as string,        _
                                                       stDefExt as string,        _
                                                        lgFlags as long           _
                                                              ) as string
    '------------------------------------------------------------------------------
    '
    ' Designed for compatibility with DISPLAY OPENFILE of PB 9+.
    '
    ' hParent  = Handle of the parent window or dialog. If there is no parent, use
    '            zero (0) or %HWND_DESKTOP.
    ' 
    ' lgPosX   = Horizontal position, in pixels, relative to the parent window.
    '            If zero, the dialog is centered horizontally on the parent,
    '            or centered horizontally on the screen if no parent. If you
    '            really want the dialog all the way to the left, use 1.
    ' 
    ' lgPosY   = Vertical position, in pixels, relative to the parent window.
    '            If zero, the dialog is centered vertically on the parent,
    '            or centered vertically on the screen if no parent. If you
    '            really want the dialog all the way to the top, use 1.
    '
    ' stTitle  = The title to be displayed in the title bar of the dialog box.
    '            If this parameter is a null, the title "Open" is displayed.
    ' 
    ' stFolder = The name of the initial file directory to be displayed. If this
    '            parameter is a null string, the current directory is used. Future
    '            invocations remember and use the ending directory, rather than
    '            honoring a null string for the current directory.
    ' 
    ' stFilter = A string expression containing pairs of null-terminated filter
    '            strings. The first string in each pair describes the filter,
    '            and the second the filter pattern. Multiple filters can be
    '            designated for a single item by separating filter pattern
    '            strings with a semicolon.
    ' 
    ' stStart  = A string which specifies the starting file name to be used as the
    '            initial file selection. This may be disabled by passing a null,
    '            zero-length string ("").
    ' 
    ' stDefExt = A default extension to be appended to the selected file name if
    '            the user does not enter it. This may be disabled by passing a
    '            null, zero-length string ("").
    ' 
    ' lgFlags  = The style attributes of the Open dialog (see the Windows API
    '            documentation for the OPENFILENAME_ structure.
    '
    '------------------------------------------------------------------------------
    
    local tOpenFileName as OPENFILENAME_
    local stFileList as string
    local szFolder as asciiz * %MAX_PATH
    local szTitle as asciiz * 128
    local lgResult as long
    local lgMark as long
    
    stFileList = $NUL + space$(32767)
    szFolder = stFolder
    szTitle = stTitle
    
    tOpenFileName.lStructSize = sizeof(tOpenFileName)
    tOpenFileName.hWndOwner = hParent
    tOpenFileName.lpstrFilter = strptr(stFilter)
    tOpenFileName.nFilterIndex = 1
    tOpenFileName.lpstrFile = strptr(stFileList)
    tOpenFileName.nMaxFile = len(stFileList)
    tOpenFileName.lpstrInitialDir = varptr(szFolder)
    tOpenFileName.lpstrTitle = varptr(szTitle)
    tOpenFileName.Flags = lgFlags or %OFN_ENABLEHOOK or %OFN_EXPLORER
    tOpenFileName.lpfnHook = codeptr(FileDlgPos)
    tOpenFileName.lCustData = ((lgPosX and &H0FFFF) * &H10000) + (lgPosY and &H0FFFF)
    lgResult = GetOpenFileName(tOpenFileName)
    
    if lgResult then
      lgMark = instr(-1, stFileList, $NUL)
      stFileList = left$(stFileList, lgMark - 1)
      function = stFileList
    else
      function = ""
    end if
    
    end function
    Code:
    ' SaveFile.bas                                          Laurence Jackson, 2011
    '------------------------------------------------------------------------------
    ' Save File dialog box for PB/Win 8 or PB/CC, designed for compatibility with
    ' the DISPLAY SAVEFILE statement of PB/Win 9+.
    '------------------------------------------------------------------------------
    ' The only difference is that user functions cannot have optional parameters
    ' in the middle of the parameter list, so the X and Y positions cannot be
    ' omitted. A value of zero is used to indicate "centered", do if you really
    ' want the dialog all the way to the top and left, use 1,1.
    '------------------------------------------------------------------------------
    
    #include "FileDlgPos.bas"
    
    %MAX_PATH      = 260
    
    %OFN_READONLY             = &H00000001
    %OFN_OVERWRITEPROMPT      = &H00000002
    %OFN_HIDEREADONLY         = &H00000004
    %OFN_NOCHANGEDIR          = &H00000008
    %OFN_SHOWHELP             = &H00000010
    %OFN_ENABLEHOOK           = &H00000020
    %OFN_ENABLETEMPLATE       = &H00000040
    %OFN_ENABLETEMPLATEHANDLE = &H00000080
    %OFN_NOVALIDATE           = &H00000100
    %OFN_ALLOWMULTISELECT     = &H00000200
    %OFN_EXTENSIONDIFFERENT   = &H00000400
    %OFN_PATHMUSTEXIST        = &H00000800
    %OFN_FILEMUSTEXIST        = &H00001000
    %OFN_CREATEPROMPT         = &H00002000
    %OFN_SHAREAWARE           = &H00004000
    %OFN_NOREADONLYRETURN     = &H00008000
    %OFN_NOTESTFILECREATE     = &H00010000
    %OFN_NONETWORKBUTTON      = &H00020000
    %OFN_NOLONGNAMES          = &H00040000
    %OFN_EXPLORER             = &H00080000
    %OFN_NODEREFERENCELINKS   = &H00100000
    %OFN_LONGNAMES            = &H00200000
    %OFN_ENABLEINCLUDENOTIFY  = &H00400000
    %OFN_ENABLESIZING         = &H00800000
    %OFN_DONTADDTORECENT      = &H02000000
    %OFN_FORCESHOWHIDDEN      = &H10000000
    
    type OPENFILENAME_
      lStructSize as dword
      hWndOwner as dword
      hInstance as dword
      lpstrFilter as asciiz ptr
      lpstrCustomFilter as asciiz ptr
      nMaxCustFilter as dword
      nFilterIndex as dword
      lpstrFile as asciiz ptr
      nMaxFile as dword
      lpstrFileTitle as asciiz ptr
      nMaxFileTitle as dword
      lpstrInitialDir as asciiz ptr
      lpstrTitle as asciiz ptr
      Flags as dword
      nFileOffset as word
      nFileExtension as word
      lpstrDefExt as asciiz ptr
      lCustData as long
      lpfnHook as dword
      lpTemplateName as asciiz ptr
      pvReserved as dword
      dwReserved as dword
      FlagsEx as dword
    end type
    
    declare function GetSaveFileName lib "COMDLG32.DLL" ___________________________
              alias "GetSaveFileNameA"                   (lpofn as OPENFILENAME_   _
                                                              ) as long
    
    function DisplaySaveFile ______________________________________________________
                                                       (hParent as dword,         _
                                                         lgPosX as long,          _
                                                         lgPosY as long,          _
                                                        stTitle as string,        _
                                                       stFolder as string,        _
                                                       stFilter as string,        _
                                                        stStart as string,        _
                                                       stDefExt as string,        _
                                                        lgFlags as long           _
                                                              ) as string
    '------------------------------------------------------------------------------
    '
    ' Designed for compatibility with DISPLAY SAVEFILE of PB 9+.
    '
    ' hParent  = Handle of the parent window or dialog. If there is no parent, use
    '            zero (0) or %HWND_DESKTOP.
    ' 
    ' lgPosX   = Horizontal position, in pixels, relative to the parent window.
    '            If negative, the dialog is centered horizontally on the parent,
    '            or centered horizontally on the screen if no parent).
    ' 
    ' lgPosY   = Vertical position, in pixels, relative to the parent window.
    '            If negative, the dialog is centered vertically on the parent,
    '            or centered vertically on the screen if no parent).
    '
    ' stTitle  = The title to be displayed in the title bar of the dialog box.
    '            If this parameter is a null, the title "Open" is displayed.
    ' 
    ' stFolder = The name of the initial file directory to be displayed. If this
    '            parameter is a null string, the current directory is used. Future
    '            invocations remember and use the ending directory, rather than
    '            honoring a null string for the current directory.
    ' 
    ' stFilter = A string expression containing pairs of null-terminated filter
    '            strings. The first string in each pair describes the filter,
    '            and the second the filter pattern. Multiple filters can be
    '            designated for a single item by separating filter pattern
    '            strings with a semicolon.
    ' 
    ' stStart  = A string which specifies the starting file name to be used as the
    '            initial file selection. This may be disabled by passing a null,
    '            zero-length string ("").
    ' 
    ' stDefExt = A default extension to be appended to the selected file name if
    '            the user does not enter it. This may be disabled by passing a
    '            null, zero-length string ("").
    ' 
    ' lgFlags  = The style attributes of the Open dialog (see the Windows API
    '            documentation for the OPENFILENAME_ structure.
    '
    '------------------------------------------------------------------------------
    
    local tOpenFileName as OPENFILENAME_
    local stFileList as string
    local szFolder as asciiz * %MAX_PATH
    local szTitle as asciiz * 128
    local lgResult as long
    local lgMark as long
    
    stFileList = $NUL + space$(32767)
    szFolder = stFolder
    szTitle = stTitle
    
    tOpenFileName.lStructSize = sizeof(tOpenFileName)
    tOpenFileName.hWndOwner = hParent
    tOpenFileName.lpstrFilter = strptr(stFilter)
    tOpenFileName.nFilterIndex = 1
    tOpenFileName.lpstrFile = strptr(stFileList)
    tOpenFileName.nMaxFile = len(stFileList)
    tOpenFileName.lpstrInitialDir = varptr(szFolder)
    tOpenFileName.lpstrTitle = varptr(szTitle)
    tOpenFileName.Flags = lgFlags or %OFN_ENABLEHOOK or %OFN_EXPLORER
    tOpenFileName.lpfnHook = codeptr(FileDlgPos)
    tOpenFileName.lCustData = ((lgPosX and &H0FFFF) * &H10000) + (lgPosY and &H0FFFF)
    lgResult = GetSaveFileName(tOpenFileName)
    
    if lgResult then
      lgMark = instr(-1, stFileList, $NUL)
      stFileList = left$(stFileList, lgMark - 1)
      function = stFileList
    else
      function = ""
    end if
    
    end function
    Code:
    ' FileDlgLoc.bas                                        Laurence Jackson, 2011
    '------------------------------------------------------------------------------
    ' File Open/Save dialog positioning procedure for use with DisplayOpenFile
    ' (OpenFile.bas) and DisplaySaveFile (SaveFile.bas) functions.
    '------------------------------------------------------------------------------
    
    #if not %def(%FILE_DLG_POS)
    
    %FILE_DLG_POS = 1
    
    %WM_INITDIALOG = &H110
    
    type OPENFILENAME_
      lStructSize as dword
      hWndOwner as dword
      hInstance as dword
      lpstrFilter as asciiz ptr
      lpstrCustomFilter as asciiz ptr
      nMaxCustFilter as dword
      nFilterIndex as dword
      lpstrFile as asciiz ptr
      nMaxFile as dword
      lpstrFileTitle as asciiz ptr
      nMaxFileTitle as dword
      lpstrInitialDir as asciiz ptr
      lpstrTitle as asciiz ptr
      Flags as dword
      nFileOffset as word
      nFileExtension as word
      lpstrDefExt as asciiz ptr
      lCustData as long
      lpfnHook as dword
      lpTemplateName as asciiz ptr
      pvReserved as dword
      dwReserved as dword
      FlagsEx as dword
    end type
    
    type RECT_
      nLeft as long
      nTop as long
      nRight as long
      nBottom as long
    end type
    
    declare function GetParentWnd_ lib "USER32.DLL" _______________________________
              alias "GetParent"                     (byval hWnd as dword          _
                                                              ) as dword
    
    declare function GetWindowRect_ lib "USER32.DLL" ______________________________
              alias "GetWindowRect"                 (byval hWnd as dword,         _
                                                         lpRect as RECT_          _
                                                              ) as long
    
    declare function MoveWindow_ lib "USER32.DLL" _________________________________
              alias "MoveWindow"                    (byval hWnd as dword,         _
                                                        byval x as long,          _
                                                        byval y as long,          _
                                                   byval nWidth as long,          _
                                                  byval nHeight as long,          _
                                                 byval bRepaint as long           _
                                                              ) as long
    
    declare function GetDesktopWindow_ lib "USER32.DLL" ___________________________
              alias "GetDesktopWindow"                       () as long
    
    
    
    function FileDlgPos ___________________________________________________________
                                                  (byval hChild as dword,         _
                                                    byval lgMsg as long,          _
                                                  byval dwParam as dword,         _
                                                  byval lgParam as long           _
                                                              ) as long
    '------------------------------------------------------------------------------
    '
    ' The purpose of this hook procedure is to allow positioning of the dialog
    ' box, either as specified or at the centre of the parent window or desktop.
    '
    ' It is common to both DisplayOpenFile and DisplaySaveFile.
    '
    '------------------------------------------------------------------------------
    
    local ptOpenFileName as OPENFILENAME_ ptr
    local tRect as RECT_
    local hFileDialog as dword
    local lgDlgW as long
    local lgDlgH as long
    local lgScrnW as long
    local lgScrnH as long
    local lgLocX as long
    local lgLocY as long
    local lgPosX as long
    local lgPosY as long
    local hParent as dword
    
    if lgMsg = %WM_INITDIALOG then
      hFileDialog = GetParentWnd_(hChild)
      ptOpenFileName = lgParam
      lgPosX = hi(word, @ptOpenFileName.lCustData)
      lgPosY = lo(word, @ptOpenFileName.lCustData)
      hParent = @ptOpenFileName.hWndOwner
      GetWindowRect_ hFileDialog, tRect
      lgDlgW = tRect.nRight - tRect.nLeft
      lgDlgH = tRect.nBottom - tRect.nTop
      if hParent = 0 then
        hParent = GetDesktopWindow_()
      end if
      GetWindowRect_ hParent, tRect
      lgScrnW = tRect.nRight - tRect.nLeft
      lgScrnH = tRect.nBottom - tRect.nTop
      lgLocX = tRect.nLeft
      lgLocY = tRect.nTop
      if lgPosX <> 0 then
        lgLocX = lgLocX + lgPosX
      else
        lgLocX = lgLocX + ((lgScrnW - lgDlgW) \ 2)
      end if
      if lgPosY <> 0 then
        lgLocY = lgLocY + lgPosY
      else
        lgLocY = lgLocY + ((lgScrnH - lgDlgH) \ 2)
      end if
      MoveWindow_ hFileDialog, lgLocX, lgLocY, lgDlgW, lgDlgH, 0
    end if
    function = 0
    
    end function
    
    #endif
    - LJ

    Comment


    • #3
      Hi Laurence

      I will check this out.

      The images to be displayed are stored in a database. Hopefully your code will replace what I do now... ie dump the string to a temp file and then reload using GDIplus.

      Thanks for posting this.

      Comment

      Working...
      X