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

FreeImage Load And Save To Memory Block

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

  • FreeImage Load And Save To Memory Block

    Useful for when dealing with images that you don't have direct access to the file, say like fetching them from a serial connection, and being able to load them into a graphic control without having to save the image to disk first.
    Code:
    ' memory load and save wrappers for FreeImage
    
    
    FUNCTION FreeImage_LoadDIBFromData(dwData AS DWORD, dwLength AS DWORD) AS DWORD
    ' assumption: dwData points to beginning of block, dwLength is length of data
    LOCAL pDib, hStream     AS DWORD
    LOCAL dibType           AS LONG
    
        ' first we attempt to open the memory buffer provided by the caller
        hStream = FreeImage_OpenMemory(BYVAL dwData, dwLength)
        IF ISTRUE hStream THEN
            ' attempt to determine the filetype from the buffer
            dibType = FreeImage_GetFileTypeFromMemory(BYVAL hStream)
            IF dibType >= 0 THEN _
                ' no other error checking or announcements if we fail
                pDib = FreeImage_LoadFromMemory(dibType, BYVAL hStream)
            FreeImage_CloseMemory hStream
        END IF
        ' we assume that the initialization of pDib will be ZERO
        FreeImage_LoadDIBFromData = pDib
        ' important note, do not call this without using the return value
        ' you WILL cause a memory leak
    END FUNCTION
    
    
    FUNCTION FreeImage_SaveDIBToData(hDib AS DWORD, FileExt AS STRING) AS STRING
    LOCAL Results                   AS STRING
    LOCAL rPointer, hPointer        AS BYTE POINTER
    LOCAL iDib, hStream, hCount     AS DWORD
    LOCAL dibType, Success          AS LONG
    
        IF ISFALSE hDib THEN EXIT FUNCTION ' redundant but useful
    
        ' open a memory stream for output, managed by FreeImage
        hStream = FreeImage_OpenMemory()
        IF ISTRUE hStream THEN
    
            ' create a clone in case bit depth needs adjusting
            ' do not tamper with the caller's image
            iDib = FreeImage_Clone(hDib)
            SELECT CASE UCASE$(FileExt)
                ' add more types as desired
                ' these are just the types as defined by my fileloader
                CASE ".BMP"
                    dibType = %FIF_BMP
                CASE ".JPG",".JPE",".JPEG"
                    dibType = %FIF_JPEG
                    IF FreeImage_GetBPP(iDib) <> 24 THEN
                        FreeImage_UnLoad iDib
                        iDib = FreeImage_ConvertTo24Bits(hDib)
                    END IF
                CASE ".PNG"
                    dibType = %FIF_PNG
                CASE ".TGA"
                    dibType = %FIF_TARGA
                CASE ".GIF"
                    dibType = %FIF_GIF
                    IF FreeImage_GetBPP(iDib) <> 8 THEN
                        FreeImage_UnLoad iDib
                        iDib = FreeImage_ColorQuantize(hDib, %FIQ_WUQUANT)
                    END IF
                CASE ELSE
                    ' if for some strange reason, user entered type not supported
                    FreeImage_UnLoad iDib
                    FreeImage_CloseMemory hStream
                    EXIT FUNCTION
            END SELECT
    
            ' attempt write to the stream, never assume success
            Success = FreeImage_SaveToMemory(dibType, iDib, hStream, %FISO_SAVE_DEFAULT)
    
            IF ISTRUE Success THEN
                ' if write was successful, gain access to the memory block
                Success = FreeImage_AcquireMemory(hStream, hPointer, hCount)
                IF ISTRUE Success THEN
                    ' *cough* DIM the string and copy the memory block to string space
                    Results = SPACE$(hCount)
                    rPointer = STRPTR(Results)
                    CopyMemory(BYVAL rPointer,BYVAL hPointer,hCount)
                END IF
            END IF
    
            ' clean up our FreeImage and close the memory stream
            FreeImage_UnLoad iDib
            FreeImage_CloseMemory hStream
    
        END IF
        ' unlike the load, the return value does not need to be used by the called
        ' powerbasic should not cause a memory leak if you don't use it
        FreeImage_SaveDIBToData = Results
    END FUNCTION
    Furcadia, an interesting online MMORPG in which you can create and program your own content.

  • #2
    Simple test program, loads image from disk, calls the memory loader for display, will save as a different image type.
    Code:
    #PBFORMS CREATED V1.51
    '------------------------------------------------------------------------------
    ' The first line in this file is a PB/Forms metastatement.
    ' ... rest of the PB/Forms header ...
    ' Feel free to make changes anywhere else in the file.
    '------------------------------------------------------------------------------
    
    #COMPILE EXE "..\memory-test.exe"
    #DIM ALL
    
    '------------------------------------------------------------------------------
    '   ** Includes **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN INCLUDES
    %USEMACROS = 1
    #IF NOT %DEF(%WINAPI)
        #INCLUDE "WIN32API.INC"
    #ENDIF
    #IF NOT %DEF(%COMMCTRL_INC)
        #INCLUDE "COMMCTRL.INC"
    #ENDIF
    #INCLUDE "PBForms.INC"
    #PBFORMS END INCLUDES
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Globals **
    '------------------------------------------------------------------------------
    GLOBAL hPopUpView   AS DWORD
    GLOBAL hMenu        AS DWORD
    GLOBAL hwndWinMain  AS DWORD
    GLOBAL hDib         AS DWORD
    
    '------------------------------------------------------------------------------
    '   ** User Includes **
    '------------------------------------------------------------------------------
    #INCLUDE "..\..\IMAGE\FREEIMAGE.INC" ' thanks to José Roca for FREEIMAGE.INC
    
    #INCLUDE "comdlg32.inc"
    #INCLUDE "memloader.bas"
    #INCLUDE "memfilename.bas"
    
    '------------------------------------------------------------------------------
    '   ** Constants **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN CONSTANTS
    %IDD_DIALOG          =  104
    %IDM_FILE_EXIT       = 1002
    %IDM_FILE_OPEN       = 1003
    %IDM_FILE_SAVE       = 1001
    %IDM_VIEW_CENTERED   = 1014
    %IDM_VIEW_LOWERLEFT  = 1007
    %IDM_VIEW_LOWERRIGHT = 1008
    %IDM_VIEW_STRETCHED  = 1010
    %IDM_VIEW_UPPERLEFT  = 1005
    %IDM_VIEW_UPPERRIGHT = 1006
    %IDR_ACCELERATOR     =   -1
    %IDR_MENU            =   -1
    %IDSB_STATUS         = 1004
    #PBFORMS END CONSTANTS
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Declarations **
    '------------------------------------------------------------------------------
    DECLARE FUNCTION AttachMENU(BYVAL hDlg AS DWORD) AS DWORD
    DECLARE FUNCTION ASSIGNACCEL(tAccel AS ACCELAPI, BYVAL wKey AS WORD, BYVAL _
        wCmd AS WORD, BYVAL byFVirt AS BYTE) AS LONG
    DECLARE FUNCTION AttachACCELERATOR(BYVAL hDlg AS DWORD) AS DWORD
    DECLARE CALLBACK FUNCTION ShowDIALOGProc()
    DECLARE FUNCTION ShowDIALOG(BYVAL hParent AS DWORD) AS LONG
    #PBFORMS DECLARATIONS
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Macros **
    '------------------------------------------------------------------------------
    MACRO FUNCTION UnloadHDib(hDib)
        FreeImage_Unload hDib
    END MACRO = 0
    
    MACRO FUNCTION UnloadObject(hObject)
        DeleteObject hObject
    END MACRO = 0
    
    MACRO ClearChecked(hDialog,hMenuBar,hMenuItem)
        MACROTEMP ChkState
        DIM ChkState AS DWORD
        MENU GET STATE hMenuBar, BYCMD hMenuItem TO ChkState
        ChkState = ChkState AND (NOT %MF_CHECKED)
        MENU SET STATE hMenuBar, BYCMD hMenuItem, ChkState
    END MACRO
    
    MACRO FUNCTION SetChecked(hDialog,hMenuBar,hMenuItem,hLastMenu)
        MACROTEMP ChkState
        DIM ChkState AS DWORD
        MENU GET STATE hMenuBar, BYCMD hLastMenu TO ChkState
        ChkState = ChkState AND (NOT %MF_CHECKED)
        MENU SET STATE hMenuBar, BYCMD hLastMenu, ChkState
        MENU GET STATE hMenuBar, BYCMD hMenuItem TO ChkState
        ChkState = ChkState OR %MF_CHECKED
        MENU SET STATE hMenuBar, BYCMD hMenuItem, ChkState
        MENU DRAW BAR hDialog
    END MACRO = hMenuItem
    
    MACRO ToggleChecked(hDialog,hMenuBar,hMenuItem)
        MACROTEMP ChkState
        DIM ChkState AS DWORD
        MENU GET STATE hMenuBar, BYCMD hMenuItem TO ChkState
        ChkState = ChkState XOR %MF_CHECKED
        MENU SET STATE hMenuBar, BYCMD hMenuItem, ChkState
    END MACRO
    
    MACRO FUNCTION GetChecked(hDialog,hMenuBar,hMenuItem)
        MACROTEMP ChkState
        DIM ChkState AS DWORD
        MENU GET STATE hMenuBar, BYCMD hMenuItem TO ChkState
        ChkState = ISTRUE (ChkState AND %MF_CHECKED)
    END MACRO = ChkState
    
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Main Application Entry Point **
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN()
        PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
            %ICC_INTERNET_CLASSES)
        ShowDIALOG %HWND_DESKTOP
    END FUNCTION
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    FUNCTION AttachMENU(BYVAL hDlg AS DWORD) AS DWORD
    #PBFORMS BEGIN MENU %IDR_MENU->%IDD_DIALOG
        LOCAL hMenu   AS DWORD
        LOCAL hPopUp1 AS DWORD
        LOCAL hPopUp2 AS DWORD
    
        MENU NEW BAR TO hMenu
        MENU NEW POPUP TO hPopUp1
        MENU ADD POPUP, hMenu, "&File", hPopUp1, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Open" + $TAB + "Ctrl+O", %IDM_FILE_OPEN, _
                %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Save" + $TAB + "Ctrl+S", %IDM_FILE_SAVE, _
                %MF_ENABLED
            MENU ADD STRING, hPopUp1, "E&xit" + $TAB + "Alt+F4", %IDM_FILE_EXIT, _
                %MF_ENABLED
        MENU NEW POPUP TO hPopUp1
        MENU ADD POPUP, hMenu, "View", hPopUp1, %MF_ENABLED
            MENU NEW POPUP TO hPopUp2
            MENU ADD POPUP, hPopUp1, "Position", hPopUp2, %MF_ENABLED
                MENU ADD STRING, hPopUp2, "Centered", %IDM_VIEW_CENTERED, _
                    %MF_ENABLED
                MENU ADD STRING, hPopUp2, "Upper Left", %IDM_VIEW_UPPERLEFT, _
                    %MF_ENABLED OR %MF_CHECKED
                MENU ADD STRING, hPopUp2, "Upper Right", %IDM_VIEW_UPPERRIGHT, _
                    %MF_ENABLED
                MENU ADD STRING, hPopUp2, "Lower Left", %IDM_VIEW_LOWERLEFT, _
                    %MF_ENABLED
                MENU ADD STRING, hPopUp2, "Lower Right", %IDM_VIEW_LOWERRIGHT, _
                    %MF_ENABLED
            MENU ADD STRING, hPopUp1, "Stretched", %IDM_VIEW_STRETCHED, _
                %MF_ENABLED
    
        MENU ATTACH hMenu, hDlg
    #PBFORMS END MENU
        FUNCTION = hMenu
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Accelerators **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN ASSIGNACCEL
    FUNCTION ASSIGNACCEL(tAccel AS ACCELAPI, BYVAL wKey AS WORD, BYVAL wCmd AS _
        WORD, BYVAL byFVirt AS BYTE) AS LONG
        tAccel.fVirt = byFVirt
        tAccel.key   = wKey
        tAccel.cmd   = wCmd
    END FUNCTION
    #PBFORMS END ASSIGNACCEL
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    FUNCTION AttachACCELERATOR(BYVAL hDlg AS DWORD) AS DWORD
    #PBFORMS BEGIN ACCEL %IDR_ACCELERATOR->%IDD_DIALOG
        LOCAL hAccel   AS DWORD
        LOCAL tAccel() AS ACCELAPI
        DIM   tAccel(1 TO 3) AS ACCELAPI
    
        ASSIGNACCEL tAccel(1), ASC("O"), %IDM_FILE_OPEN, %FVIRTKEY OR %FCONTROL _
            OR %FNOINVERT
        ASSIGNACCEL tAccel(2), ASC("S"), %IDM_FILE_SAVE, %FVIRTKEY OR %FCONTROL _
            OR %FNOINVERT
        ASSIGNACCEL tAccel(3), %VK_F4, %IDM_FILE_EXIT, %FVIRTKEY OR %FALT OR _
            %FNOINVERT
    
        ACCEL ATTACH hDlg, tAccel() TO hAccel
    #PBFORMS END ACCEL
        FUNCTION = hAccel
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** CallBacks **
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowDIALOGProc()
    LOCAL hDCPaint      AS DWORD
    LOCAL ClientPS      AS PAINTSTRUCT
    LOCAL ClientRC      AS RECT
    LOCAL OffSetX       AS LONG
    LOCAL OffSetY       AS LONG
    LOCAL fiWidth       AS DWORD
    LOCAL fiHeight      AS DWORD
    LOCAL fiBits        AS DWORD
    LOCAL fiInfoPtr     AS BITMAPINFOHEADER POINTER
    LOCAL fiInfo        AS BITMAPINFOHEADER
    LOCAL SaveName      AS STRING
    LOCAL ChkMenu       AS DWORD
    LOCAL strInOut      AS STRING
    LOCAL FileInOut     AS LONG
    
    STATIC FileName         AS STRING
    STATIC LastViewState    AS DWORD
    
        SELECT CASE AS LONG CB.MSG
            CASE %WM_INITDIALOG
                hwndWinMain = CB.HNDL
                ' there's got to be a better way of locating a menu element
                LOCAL mIndex AS LONG, mString AS STRING
                hMenu = GetMenu(hwndWinMain)
                FOR mIndex = 1 TO GetMenuItemCount(hMenu)
                    MENU GET TEXT hMenu, mIndex TO mString
                    IF mString = "View" THEN EXIT FOR
                NEXT mIndex
                hPopUpView = mIndex
                LastViewState = %IDM_VIEW_UPPERLEFT
                MENU SET STATE hMenu, hPopUpView, %MF_GRAYED
                MENU SET STATE hMenu, BYCMD %IDM_FILE_SAVE, %MF_GRAYED
    
            CASE %WM_DESTROY
                IF ISTRUE hDib THEN hDib = UnloadHDib(hDib)
    
            CASE %WM_SIZE
                ' Dialog has been resized
                CONTROL SEND CB.HNDL, %IDSB_STATUS, CBMSG, CBWPARAM, CBLPARAM
                DIALOG REDRAW CB.HNDL
    
           CASE %WM_PAINT
                hDCPaint = BeginPaint(CB.HNDL, ClientPS)
                IF hDCPaint = %NULL THEN EXIT FUNCTION
                IF ISTRUE hDib THEN
                    GetClientRect CB.HNDL, ClientRC
                    CONTROL GET SIZE CB.HNDL, %IDSB_STATUS TO OffSetX, OffSetY
                    ClientRC.nBottom = ClientRC.nBottom - OffSetY
                    fiWidth     = FreeImage_GetWidth(hDib)
                    fiHeight    = FreeImage_GetHeight(hDib)
                    fiBits      = FreeImage_GetBits(hDib)
                    fiInfoPtr   = FreeImage_GetInfoHeader(hDib)
                    fiInfo      = @fiInfoPtr
                    IF ISTRUE GetChecked(CB.HNDL,hMenu,%IDM_VIEW_STRETCHED) THEN
                        StretchDIBits _
                            ClientPS.hDC,       _ ' handle to DC
                            ClientRC.nLeft,     _ ' x-coord of destination upper-left corner
                            ClientRC.nTop,      _ ' y-coord of destination upper-left corner
                            ClientRC.nRight,    _ ' width of destination rectangle
                            ClientRC.nBottom,   _ ' height of destination rectangle
                            0,                  _ ' x-coord of source upper-left corner
                            0,                  _ ' y-coord of source upper-left corner
                            fiWidth,            _ ' width of source rectangle
                            fiHeight,           _ ' height of source rectangle
                            BYVAL fiBits,       _ ' bitmap bits
                            BYVAL fiInfoPtr,    _ ' bitmap data
                            %DIB_RGB_COLORS,    _ ' usage options
                            %SRCCOPY              ' raster operation code
                    ELSE
                        SELECT CASE LastViewState
                            CASE %IDM_VIEW_CENTERED
                                OffSetX = fiWidth / 2
                                OffSetY = ClientRC.nRight / 2
                                ClientRC.nLeft = OffSetY - OffSetX
                                OffSetX = fiHeight / 2
                                OffSetY = ClientRC.nBottom / 2
                                ClientRC.nTop = OffSetY - OffSetX
                            CASE %IDM_VIEW_LOWERLEFT
                                ClientRC.nTop = ClientRC.nBottom - fiHeight
                            CASE %IDM_VIEW_LOWERRIGHT
                                ClientRC.nLeft = ClientRC.nRight - fiWidth
                                ClientRC.nTop = ClientRC.nBottom - fiHeight
                            CASE %IDM_VIEW_UPPERLEFT
                                ' for clarity, we leave ClientRC.nLeft & .nTop alone
                            CASE %IDM_VIEW_UPPERRIGHT
                                ClientRC.nLeft = ClientRC.nRight - fiWidth
                        END SELECT
                        SetDIBitsToDevice ClientPS.hDC, ClientRC.nLeft, ClientRC.nTop, fiWidth, fiHeight, 0, 0, _
                            0, fiHeight, BYVAL fiBits, BYVAL fiInfoPtr, %DIB_RGB_COLORS
                    END IF
                END IF
                EndPaint CB.HNDL, ClientPS
    
            CASE %WM_MENUSELECT
                ' Update the status bar text
    
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CB.WPARAM THEN
                    ' Save control focus
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    ' Restore control focus
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
    
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE AS LONG CB.CTL
    
                    CASE %IDM_FILE_OPEN
                        FileName = GetFileName($EveryImage, "", "Open An Image File", %OFN_FILEMUSTEXIST)
                        IF LEN(FileName) > 0 THEN
                            MENU SET STATE hMenu, hPopUpView, %MF_GRAYED
                            MENU SET STATE hMenu, BYCMD %IDM_FILE_SAVE, %MF_GRAYED
                            MENU DRAW BAR CB.HNDL
                            STATUSBAR SET TEXT CB.HNDL, %IDSB_STATUS, 1, 0, "Opened: " & FileName
                            IF ISTRUE hDib THEN hDib = UnloadHDib(hDib)
                            FileInOut = FREEFILE
                            OPEN FileName FOR BINARY AS FileInOut
                            GET$ #FileInOut, LOF(FileInOut), strInOut
                            CLOSE #FileInOut
                            hDib = FreeImage_LoadDIBFromData(STRPTR(strInOut), LEN(strInOut))
                            IF ISTRUE hDib THEN
                                ' SaveName = exe.path$ & "results.bmp"
                                ' FreeImage_Save 0, hDib, SaveName
                                STATUSBAR SET TEXT CB.HNDL, %IDSB_STATUS, 1, 0, "Opened: " & FileName
                                MENU SET STATE hMenu, hPopUpView, %MF_ENABLED
                                MENU SET STATE hMenu, BYCMD %IDM_FILE_SAVE, %MF_ENABLED
                                LastViewState = SetChecked(CB.HNDL,hMenu,%IDM_VIEW_UPPERLEFT,LastViewState)
                                ClearChecked(CB.HNDL,hMenu,%IDM_VIEW_STRETCHED)
                                MENU DRAW BAR CB.HNDL
                                DIALOG REDRAW CB.HNDL
                            ELSE
                                STATUSBAR SET TEXT CB.HNDL, %IDSB_STATUS, 1, 0, "Open Failed: " & FileName
                                DIALOG REDRAW CB.HNDL
                            END IF
                        END IF
    
                    CASE %IDM_FILE_SAVE
                        IF ISTRUE hDib THEN ' sort of obvious you need an image
                            SaveName = GetFileName($AllImages, FileName, "Save Image As", %OFN_OVERWRITEPROMPT)
                            strInOut = FreeImage_SaveDIBToData(hDib, PATHNAME$(EXTN, SaveName))
                            IF LEN(strInOut) > 0 THEN
                                FileName = SaveName
                                STATUSBAR SET TEXT CB.HNDL, %IDSB_STATUS, 1, 0, "Saved As: " & FileName
                                IF ISTRUE ISFILE(FileName) THEN KILL FileName
                                FileInOut = FREEFILE
                                OPEN FileName FOR BINARY AS FileInOut
                                PUT$ #FileInOut, strInOut
                                CLOSE #FileInOut
                            END IF
                        END IF
    
                    CASE %IDM_FILE_EXIT
                        DIALOG END CB.HNDL
    
                    CASE %IDM_VIEW_CENTERED
                        IF LastViewState <> %IDM_VIEW_CENTERED THEN
                            LastViewState = SetChecked(CB.HNDL,hMenu,%IDM_VIEW_CENTERED,LastViewState)
                            DIALOG REDRAW CB.HNDL
                        END IF
                    CASE %IDM_VIEW_LOWERLEFT
                        IF LastViewState <> %IDM_VIEW_LOWERLEFT THEN
                            LastViewState = SetChecked(CB.HNDL,hMenu,%IDM_VIEW_LOWERLEFT,LastViewState)
                            DIALOG REDRAW CB.HNDL
                        END IF
                    CASE %IDM_VIEW_LOWERRIGHT
                        IF LastViewState <> %IDM_VIEW_LOWERRIGHT THEN
                            LastViewState = SetChecked(CB.HNDL,hMenu,%IDM_VIEW_LOWERRIGHT,LastViewState)
                            DIALOG REDRAW CB.HNDL
                        END IF
                    CASE %IDM_VIEW_STRETCHED
                        ToggleChecked(CB.HNDL,hMenu,%IDM_VIEW_STRETCHED)
                        DIALOG REDRAW CB.HNDL
    
                    CASE %IDM_VIEW_UPPERLEFT
                        IF LastViewState <> %IDM_VIEW_UPPERLEFT THEN
                            LastViewState = SetChecked(CB.HNDL,hMenu,%IDM_VIEW_UPPERLEFT,LastViewState)
                            DIALOG REDRAW CB.HNDL
                        END IF
                    CASE %IDM_VIEW_UPPERRIGHT
                        IF LastViewState <> %IDM_VIEW_UPPERRIGHT THEN
                            LastViewState = SetChecked(CB.HNDL,hMenu,%IDM_VIEW_UPPERRIGHT,LastViewState)
                            DIALOG REDRAW CB.HNDL
                        END IF
    
                END SELECT
        END SELECT
    END FUNCTION
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Dialogs **
    '------------------------------------------------------------------------------
    FUNCTION ShowDIALOG(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt AS LONG
    
    #PBFORMS BEGIN DIALOG %IDD_DIALOG->%IDR_MENU->%IDR_ACCELERATOR
        LOCAL hDlg  AS DWORD
    
        DIALOG NEW PIXELS, hParent, "Freeimage Memory Test", 291, 153, 300, 200, _
            %WS_POPUP OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
            %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR _
            %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
            %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
            %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
        DIALOG  SET COLOR hDlg, %BLACK, %WHITE
        CONTROL ADD "msctls_statusbar32", hDlg, %IDSB_STATUS, "Status", 0, 161, _
            300, 19, %WS_CHILD OR %WS_VISIBLE, %WS_EX_TRANSPARENT OR %WS_EX_LEFT _
            OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
    
        AttachMENU hDlg
    
        AttachACCELERATOR hDlg
    #PBFORMS END DIALOG
    
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOGProc TO lRslt
    
    #PBFORMS BEGIN CLEANUP %IDD_DIALOG
    #PBFORMS END CLEANUP
    
        FUNCTION = lRslt
    END FUNCTION
    '------------------------------------------------------------------------------
    Furcadia, an interesting online MMORPG in which you can create and program your own content.

    Comment


    • #3
      Because I write my own wrappers for the Get..FileName common dialogs.
      Code:
      ' file loader
      
      $BmpFiles = "Bitmap Images (*.bmp)|*.bmp"
      $GifFiles = "GIF Images (*.gif)|*.gif"
      $JpgFiles = "JPG Images (*.jpg)|*.jpg;*.jpeg"
      $PcxFiles = "PCX Files (*.pcx)|*.pcx"
      $PngFiles = "PNG Images (*.png)|*.png"
      $TgaFiles = "Targa Images (*.tga)|*.tga"
      $AllImages = $BmpFiles & "|" & $PngFiles & "|" & $GifFiles & "|" & $JpgFiles & "|" & $TgaFiles
      $EveryImage = "Supported Images|*.bmp;*.gif;*.jpg;*.jpeg;*.pcx;*.png;*.tga" & "|" & $AllImages & "|" & $PcxFiles
      
      
      FUNCTION GetFileName(FileFilter AS STRING, FilePath AS STRING, FileTitle AS STRING, OpenMode AS LONG) AS STRING
      DIM OFName AS OPENFILENAME, dlgError AS LONG
      LOCAL FileName AS ASCIIZ * %max_path
      LOCAL strPath, strName, strExt, strFilter AS STRING
          OFName.lStructSize          = LEN(OFName)
          OFName.hwndOwner            = hwndWinMain
          OFName.hInstance            = 0
          strFilter = FileFilter & "||"
          REPLACE "|" WITH CHR$(0) IN strFilter
          OFName.lpstrFilter          = STRPTR(strFilter)
          IF LEN(FilePath) > 0 THEN
              strPath = PATHNAME$(PATH, FilePath)
              FileName = PATHNAME$(NAMEX, FilePath)
              strExt = PATHNAME$(EXTN, FilePath)
              REPLACE strExt WITH "" IN FileName
              REPLACE "." WITH "" IN strExt
          END IF
          OFName.lpstrFile            = VARPTR(FileName)
          OFName.nMaxFile             = %max_path
          OFName.lpstrInitialDir      = STRPTR(strPath)
          OFName.lpstrTitle           = STRPTR(FileTitle)
          OFName.Flags                = OpenMode OR %OFN_PATHMUSTEXIST
          IF (LEN(strExt) = 0) AND (OpenMode = %OFN_OVERWRITEPROMPT) THEN
              strExt = PARSE$(strFilter, CHR$(0), 2)
              strExt = PARSE$(strExt, ".", 2)
          END IF
          OFName.lpstrDefExt          = STRPTR(strExt)
          IF (OpenMode = %OFN_OVERWRITEPROMPT) THEN
              dlgError = GetSaveFileName(OFName)
          ELSE
              dlgError = GetOpenFileName(OFName)
          END IF
          IF dlgError = 0 THEN
              dlgError = CommDlgExtendedError()
              IF ISTRUE dlgError THEN
                  MSGBOX "Dialog returned error code: " & HEX$(dlgError, 8)
              END IF
              FileName = ""
          END IF
          GetFileName = RTRIM$(FileName, ANY " " & CHR$(0))
      END FUNCTION
      Furcadia, an interesting online MMORPG in which you can create and program your own content.

      Comment

      Working...
      X