ImageGrid (combine multiple image files into one giant poster)

Code: (Select All)
' -----------------------------------------------------------------------------

' INITIAL INQUIRY

' https://qb64phoenix.com/forum/showthread.php?tid=3153



' From: madscijr

' Date: 10-23-2024, 02:55 PM (This post was last modified: 10-23-2024, 02:58 PM by madscijr.)

' Before I go and reinvent the wheel, I'm wondering if this or something similar already exists...?

'

' I'm thinking a program that

'

' * looks in a directory like "c:\Users\MyUser\Pictures"

'   (extra points if it can handle environment variables like "%USERPROFILE%\Pictures")

'

' * finds all images (extra points if it lets you specify 1 or more wildcards

'   to match like "*.jpg;*.png;*.gif")

'

' * gets the size of all of them and figures out (based on layout chosen)

'   how big the final image will be & initialize it

'   (I'm not sure what kind of limitations QB64PE has for image size,

'   I am thinking this prog would limit the size only based on the

'   computer memory & hard drive space)

'

' * for each pic:

'   loads it into memory,

'   resize/scale/rotate (depending on options)

'   copies to a new giant image (depending on the layout you choose,

'   e.g., if we have 16 pictures, maybe 4 columns x 4 rows, or 8 columns x 2 rows)

'

' * outputs a new image file in the selected format.

'

' I'm thinking of some fancy features like if the pictures are different sizes,

' it can resize them / rotate them / stretch them, depending on what you can choose,

' to whatever the largest common dimension is, or maybe it can detect a picture's

' orientation, and auto rotate so they are all landscape or portrait, or figure out

' how to lay them out so there is minimal blank space.

'

' Maybe an option to not rotate but fill in the blank space with a given background color,

' or if there are not enough pics for an even # of rows/columns, fill in empty areas

' with some default color or pattern.

'

' Some of the things I'm going to have to figure out how to do for this include

'

' * list files from a folder

' * match based on *? wildcards

' * load an image file into a _NewImage

' * detect image height/width

' * rotate image

' * scale/resize image

' * stretch/skew image

' * display an image bigger than the screen shrunk down to fit the screen

'   (to preview on screen)

' * save image from memory to a file

'

' Simple use cases:

'

' * make a pic collage for your PC's desktop

' * take a bunch of pictures and turn them into a poster you can have printed

'   at somewhere like CVS (the web site says 24"x36" is $15.99 ?!)

' * make a background for a game

'

' Has anyone seen or done anything like that?

' -----------------------------------------------------------------------------



' Asking ChatGPT for help:

'

' Q: Write me a QB64PE program that prompts the user with a file dialog to select a local folder, then scans the folder for image files (in supported formats such as JPEG, JPG, PNG) and loads all images into memory and copies them all into a single giant image laid out as a grid, and saves the giant image to a new image file in both PNG and JPEG formats.

' A: Here's a QB64PE program that does what you asked. It uses QB64’s capability to work with files, load images, and create graphical content.

'    Before running this, make sure you have the necessary libraries and dependencies for QB64PE, particularly for handling image files.

'

' How It Works:

' 1.  Folder Selection:

'     - _HOPEN$() opens a dialog for the user to select a folder.

' 2.  Scanning for Images:

'     - The DIR$() function identifies .png, .jpg, and .jpeg files in the selected folder.

' 3.  Loading Images:

'     - _LOADIMAGE loads images into memory and captures their dimensions.

' 4.  Grid Arrangement:

'     - The program calculates the number of rows and columns for the grid and arranges images accordingly.

' 5.  Creating and Saving the Grid:

'     - A new blank image (_NEWIMAGE) is created, and the smaller images are placed onto it using _PUTIMAGE.

'     - The final image is saved as both PNG and JPEG using _SAVEIMAGE.

' 6.  Output:

'     - The final image is saved as image_grid.png and image_grid.jpg in the selected folder.

'

' Prerequisites:

' * Ensure QB64PE has access to the folder where images are stored.

' * Adjust paths or image size limits if necessary.



' QB64PE Program to Create a Grid of Images

' uses functions:

' FUNCTION _LOADIMAGE% (filename$, format%)

' SUB _PUTIMAGE (source&, x, y, dest&, method)

' FUNCTION _NEWIMAGE% (width%, height%, depth%)

' SUB _SAVEIMAGE (handle%, filename$, format%)

' folder$ = _SELECTFOLDERDIALOG$([title$][, defaultPath$])



Option _Explicit



Const FALSE = 0

Const TRUE = Not FALSE



' Header file "makeint.h" must be in same folder as this program.

Declare CustomType Library "direntry"

    Function load_dir& (s As String)

    Function has_next_entry& ()

    Sub close_dir ()

    Sub get_next_entry (s As String, flags As Long, file_size As Long)

End Declare

'Declare CustomType Library "direntry"

'    Function FILE_load_dir& Alias load_dir (s As String)

'    Function FILE_has_next_entry& Alias has_next_entry ()

'    Sub FILE_close_dir Alias close_dir ()

'    Sub FILE_get_next_entry Alias get_next_entry (s As String, flags As Long, file_size As Long)

'    Sub FILE_get_current_dir Alias get_current_dir (s As String)

'    Function FILE_current_dir_length& Alias current_dir_length ()

'End Declare



' ERROR TRACKING

Dim Shared m_sError$: m_sError$ = ""



' BASIC PROGRAM METADATA

Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))

Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)



' USED BY TIMER

Dim Shared m_iTimerCount As Long



' =============================================================================

' START THE MAIN ROUTINE

ImageGrid



' =============================================================================

' FINISH

System ' return control to the operating system



' /////////////////////////////////////////////////////////////////////////////



Sub ImageGrid

    ' CONSTANTS

    Const FORMAT_PNG = 32

    Const FORMAT_JPG = 33



    ReDim FileArray$(-1 To -1)

    ReDim FolderArray$(-1 To -1)

    Dim ImageHandleArray&(100)

    Dim WidthArray&(100)

    Dim HeightArray&(100)

    Dim TotalWidth&

    Dim TotalHeight&

    Dim xPos&

    Dim yPos&

    Dim iLoop As Integer

    Dim SelectedPath$

    Dim FilePath$

    Dim iCols As Integer

    Dim iRows As Integer

    Dim GridImage&

    Dim in$

    Dim sError As String: sError = ""

    Dim iNum As Integer

    Dim iIndex As Integer

    

    ' INIT SCREEN

    Screen _NewImage(1280, 1024, 32)

    _ScreenMove 0, 0



    Do

        ' Show title

        Cls

        Print "Welcome to the Image Grid Maker!"

        Print "Please select a folder containing image files (JPG, PNG)."



        ' Prompt user to select a folder

        'SelectedPath$ = _HOPEN$

        SelectedPath$ = _SelectFolderDialog$("Select folder containing images", m_ProgramPath$)



        ' EXIT IF NONE

        If SelectedPath$ = "" Then

            Print "No folder selected. Exiting program."

            End

        End If



        ' Scan folder for image files

        Print "Scanning folder: " + SelectedPath$

        'FileArray$ = DIR$(SelectedPath$ + "\*.png;*.jpg;*.jpeg", 2)

        sError = GetFileList$(SelectedPath$, "png;jpg;jpeg", FolderArray$(), FileArray$())

        If Len(sError) = 0 Then

            If UBound(FileArray$) > -1 Then

                iNum = UBound(FileArray$) + 1

                Print "Found " + _Trim$(Str$(iNum)) + " image(s)."

            Else

                ' EXIT IF NONE

                iNum = UBound(FileArray$) + 1

                Print "Found " + _Trim$(Str$(iNum)) + " image(s)."

                Print "No image files found in the selected folder."

                End

            End If

        Else

            ' EXIT IF ERROR

            Print sError

            End

        End If



        ' Load all image files into memory

        Print "Loading images into memory."

        iIndex = LBound(ImageHandleArray&) - 1

        For iLoop = LBound(FileArray$) To UBound(FileArray$)

            If Len(FileArray$(iLoop)) > 0 Then

                iIndex = iIndex + 1

                

                FilePath$ = SelectedPath$ + "\" + FileArray$(iLoop)

                

                ' _LoadImage: Image file formats JPG, PNG, TGA, BMP, PSD, GIF, HDR, PIC, PNM, PCX, SVG, ICO, CUR and QOI are supported.

                Print _Trim$(Str$(iLoop)) + ". ImageHandleArray&(" + _Trim$(Str$(iIndex)) + ") = _LoadImage(" + Chr$(34) + FileArray$(iLoop) + Chr$(34) + ", 32)"

                

                ImageHandleArray&(iIndex) = _LoadImage(FilePath$, 32)

                

                ' EXIT IF ERROR

                If ImageHandleArray&(iIndex) = 0 Then

                    Print "Error loading image: " + FilePath$

                    End

                End If

                

                ' Get dimensions of each image

                WidthArray&(iIndex) = Abs(_Width(ImageHandleArray&(iLoop)))

                HeightArray&(iIndex) = Abs(_Height(ImageHandleArray&(iLoop)))

                

                Print "    WidthArray&(" + _Trim$(Str$(iIndex)) + ") = " + _Trim$(Str$(WidthArray&(iIndex))) + ", " + "HeightArray&(" + _Trim$(Str$(iIndex)) + ") = " + _Trim$(Str$(HeightArray&(iIndex)))

            End If

        Next iLoop

        

        ' Determine grid dimensions

        Print "Determining grid dimensions:"



        iCols = Int(Sqr(UBound(FileArray$) + 1)) ' Number of columns

        iRows = Int((UBound(FileArray$) + 1) / iCols) + 1 ' Number of rows

        Print "iCols  = " + _Trim$(Str$(iCols))

        Print "iRows  = " + _Trim$(Str$(iRows))



        TotalWidth& = GetMaxInLongArray&(WidthArray&()) * iCols

        TotalHeight& = GetMaxInLongArray&(HeightArray&()) * iRows

        Print "TotalWidth&  = " + _Trim$(Str$(TotalWidth&))

        Print "TotalHeight& = " + _Trim$(Str$(TotalHeight&))



        ' Create a new image for the grid

        Print "Creating a new image for the grid"

        GridImage& = _NewImage(TotalWidth&, TotalHeight&, 32)



        ' Arrange images in a grid and copy to the new image

        xPos& = 0

        yPos& = 0

        For iLoop = LBound(FileArray$) To UBound(FileArray$)

            'Print IIFS$(iLoop > LBound(FileArray$), ",", "") + _Trim$(Str$(iLoop))

            Print _Trim$(Str$(iLoop)) + ". Adding image " + Chr$(34) + NameOnly$(FileArray$(iLoop)) + Chr$(34)



            '_PutImage (xDest%, yDest%), imgTiles&, , (sx1%, sy1%)-(sx2%, sy2%)

            '_PutImage (arrTileMap(dx%, dy%).xPos, arrTileMap(dx%, dy%).yPos), imgTiles&, imgScreen&, (arrTileSheetMap(TileNum%).xStart, arrTileSheetMap(TileNum%).yStart)-(arrTileSheetMap(TileNum%).xEnd, arrTileSheetMap(TileNum%).yEnd)



            '_PUTIMAGE (0, 0), iLoop ' places image at upper left corner of window w/o stretching it

            '_PUTIMAGE (dx1, dy1), sourceHandle&, destHandle&, (sx1, sy1)-(sx2, sy2) ' portion of source to the top-left corner of the destination page

            '_PUTIMAGE (64,  128), imgTiles&,      imgScreen&,   (128, 128)-(164, 164) ' portion of source to the top-left corner of the destination page

            '_PutImage (64, 128), imgTiles&, imgScreen&, (128, 128)-(164, 164) ' portion of source to the top-left corner of the destination page

            

            'if xPos& + Abs(_Width(ImageHandleArray&(iLoop))) <= TotalWidth& then

            '   if yPos& + Abs(_Height(ImageHandleArray&(iLoop))) <= TotalHeight& then

                    

            '_PUTIMAGE (dx1, dy1)-(dx2, dy2), sourceHandle&, destHandle& 'size full source to destination coordinate area

            _PutImage (xPos&, yPos&), ImageHandleArray&(iLoop), GridImage&

                    

            xPos& = xPos& + WidthArray&(iLoop)

            If xPos& >= TotalWidth& Then

                xPos& = 0

                yPos& = yPos& + HeightArray&(iLoop)

            End If

            '   else

            '       print "    Image height " + _Trim$(Str$(Abs(_Height(ImageHandleArray&(iLoop))))) + _

            '           "y position " + _Trim$(Str$(yPos&)) + _

            '           "won't fit on image height " + _Trim$(Str$(TotalHeight&))

            '   end if

            'else

            '       print "    Image width " + _Trim$(Str$(Abs(_Width(ImageHandleArray&(iLoop))))) + _

            '           "x position " + _Trim$(Str$(xPos&)) + _

            '           "won't fit on image width " + _Trim$(Str$(TotalWidth&))

            'end if

        Next iLoop



        ' Save the grid image as PNG and JPEG

        Print "Saving the final grid image..."

        '_SAVEIMAGE gridImage&, SelectedPath$ + "\image_grid.png", FORMAT_PNG

        '_SAVEIMAGE gridImage&, SelectedPath$ + "\image_grid.jpg", FORMAT_JPG



        ' _SAVEIMAGE saves the contents of an image or screen page to an image file.

        ' https://qb64phoenix.com/qb64wiki/index.php/SAVEIMAGE

        ' Syntax: _SAVEIMAGE fileName$[, ImageHandleArray&][, requirements$]

        ' Parameters

        '     fileName$ is literal or variable STRING file name value.

        '     Optional ImageHandleArray& is a LONG image handle or a valid screen page number.

        '     Optional requirements$ STRING values can be:

        '         BMP: Saves the image as Windows Bitmap if no file extension is specified.

        '         GIF: Saves the image as Graphics Interchange Format if no file extension is specified.

        '         HDR: Saves the image as Radiance HDR if no file extension is specified.

        '         ICO: Saves the image as Windows Icon if no file extension is specified.

        '         JPG: Saves the image as Joint Photographic Experts Group if no file extension is specified.

        '         PNG: Saves the image as Portable Network Graphics if no file extension is specified.

        '         QOI: Saves the image as Quite OK Image if no file extension is specified.

        '         TGA: Saves the image as Truevision TARGA if no file extension is specified.

        _SaveImage SelectedPath$ + "\ImageGrid.png", GridImage&, "PNG"

        _SaveImage SelectedPath$ + "\ImageGrid.png", GridImage&, "JPG"



        Print "Image grid saved as 'ImageGrid.png' and 'ImageGrid.jpg' in the selected folder."

        Print "Task completed successfully!"



        ' Clean up

        For iLoop = 0 To UBound(FileArray$)

            _FreeImage ImageHandleArray&(iLoop)

        Next iLoop



        _FreeImage GridImage&



        Do

            Input "Create another (y/n)"; in$: in$ = LCase$(Left$(in$, 1))

            If in$ = "y" Or in$ = "n" Then

                Exit Do

            Else

                Print "Please type y or n."

            End If

        Loop

        If in$ = "n" Then Exit Do

    Loop



    'End

End Sub ' ImageGrid



' /////////////////////////////////////////////////////////////////////////////

' FROM: https://qb64phoenix.com/forum/showthread.php?tid=769&pid=20943#pid20943



Function GetFileList$ (SearchDirectory As String, FileExtensionList As String, DirListArray() As String, FileListArray() As String)

    Const IS_DIR = 1

    Const IS_FILE = 2

    

    Dim sError As String: sError = ""

    Dim flags As Long

    Dim file_size As Long

    Dim DirCount As Integer: DirCount = LBound(DirListArray) - 1

    Dim FileCount As Integer: FileCount = LBound(FileListArray) - 1

    Dim length&

    Dim nam$

    Dim FileExtList As String

    Dim sFileExt As String

    

    FileExtList = ";" + LCase$(FileExtensionList) + ";"

    

    'ReDim _Preserve DirListArray(100), FileListArray(100)

    

    'If _DirExists(SearchDirectory) = TRUE Then

    If load_dir(SearchDirectory + Chr$(0)) Then

        Do

            length& = has_next_entry&

            If length& > -1 Then

                nam$ = Space$(length&)

                get_next_entry nam$, flags, file_size

                If flags And IS_DIR Then

                    Print "        FOUND FOLDER " + Chr$(34) + nam$ + Chr$(34)

                    DirCount = DirCount + 1

                    If DirCount > UBound(DirListArray) Then

                        ReDim _Preserve DirListArray(UBound(DirListArray) + 1)

                    End If

                    DirListArray(DirCount) = nam$

                ElseIf flags And IS_FILE Then

                    sFileExt = ";" + LCase$(GetFileExt$(nam$)) + ";"

                    If InStr(1, FileExtList, sFileExt) > 0 Then

                        Print "        FOUND FILE   " + Chr$(34) + nam$ + Chr$(34)

                        FileCount = FileCount + 1

                        If FileCount > UBound(FileListArray) Then

                            ReDim _Preserve FileListArray(UBound(FileListArray) + 1)

                        End If

                        FileListArray(FileCount) = nam$

                    Else

                        Print "        IGNORING NON-IMAGE FILE " + Chr$(34) + nam$ + Chr$(34)

                    End If

                End If

            End If

        Loop Until length& = -1

        close_dir

        

        Print "Found " + _Trim$(Str$(FileCount)) + " file(s)."

        Print "Found " + _Trim$(Str$(DirCount)) + " folder(s)."

    Else

        sError = "SearchDirectory not found."

    End If

    ReDim _Preserve DirListArray(DirCount)

    ReDim _Preserve FileListArray(FileCount)

    

    GetFileList$ = sError

End Function ' GetFileList$



' /////////////////////////////////////////////////////////////////////////////



Function GetMaxInIntArray% (MyArray() As Integer)

    Dim iMax%

    Dim iLoop%



    Print "    GetMaxInIntArray% (MyArray(" + _

        _Trim$(Str$( LBound(MyArray) ) ) + " To " + _

        _Trim$(Str$( uBound(MyArray) ) ) + ")"





    iMax% = MyArray(LBound(MyArray))



    Print "        INITIALIZE iMax% = MyArray(LBound(MyArray)) = " + _Trim$(Str$(iMax%))



    For iLoop% = LBound(MyArray) To UBound(MyArray)

        If MyArray(iLoop%) > iMax% Then

            iMax% = MyArray(iLoop%)



            Print "        iMax% = MyArray(" + _Trim$(Str$(iLoop%)) + ") = " + _Trim$(Str$(iMax%))

        End If

    Next iLoop%



    Print "        FINAL GetMaxInIntArray% = iMax% = " + _Trim$(Str$(iMax%))



    GetMaxInIntArray% = iMax%

End Function ' GetMaxInIntArray%



' /////////////////////////////////////////////////////////////////////////////



Function GetMaxInLongArray& (MyArray() As Long)

    Dim iMax&

    Dim iLoop%

    

    Print "    GetMaxInLongArray& (MyArray(" + _

        _Trim$(Str$( LBound(MyArray) ) ) + " To " + _

        _Trim$(Str$( uBound(MyArray) ) ) + ")"

    

    iMax& = MyArray(LBound(MyArray))

    

    Print "        INITIALIZE iMax& = MyArray(LBound(MyArray)) = " + _Trim$(Str$(iMax&))

    

    For iLoop% = LBound(MyArray) To UBound(MyArray)

        If MyArray(iLoop%) > iMax& Then

            iMax& = MyArray(iLoop%)

            

            Print "        iMax% = MyArray(" + _Trim$(Str$(iLoop%)) + ") = " + _Trim$(Str$(iMax&))

        End If

    Next iLoop%

    

    Print "        FINAL GetMaxInIntArray% = iMax& = " + _Trim$(Str$(iMax&))

    

    GetMaxInLongArray& = iMax&

End Function ' GetMaxInLongArray&



' /////////////////////////////////////////////////////////////////////////////



Function NameOnly$ (FilePath$)

    Dim iPos%

    iPos% = _InStrRev(FilePath$, "\")

    If iPos% > 0 Then

        NameOnly$ = Right$(FilePath$, Len(FilePath$) - iPos%)

    Else

        NameOnly$ = FilePath$

    End If

End Function ' NameOnly$



' /////////////////////////////////////////////////////////////////////////////



Function GetFileExt$ (FilePath$)

    Dim iPos%

    iPos% = _InStrRev(FilePath$, ".")

    If iPos% > 0 Then

        GetFileExt$ = Right$(FilePath$, Len(FilePath$) - iPos%)

    Else

        GetFileExt$ = ""

    End If

End Function ' GetFileExt$



' /////////////////////////////////////////////////////////////////////////////

' IIF function for QB for integers



Function IIF (Condition, IfTrue, IfFalse)

    If Condition Then IIF = IfTrue Else IIF = IfFalse

End Function



' /////////////////////////////////////////////////////////////////////////////

' IIF function for QB for strings



Function IIFS$ (Condition, IfTrue$, IfFalse$)

    If Condition Then IIFS$ = IfTrue$ Else IIFS$ = IfFalse$

End Function



' /////////////////////////////////////////////////////////////////////////////



' SOME USEFUL STUFF FOR REFERENCE:



' Type Name               Type suffix symbol   Minimum value                  Maximum value                Size in Bytes

' ---------------------   ------------------   ----------------------------   --------------------------   -------------

' _BIT                    `                    -1                             0                            1/8

' _BIT * n                `n                   -128                           127                          n/8

' _UNSIGNED _BIT          ~`                   0                              1                            1/8

' _BYTE                   %%                   -128                           127                          1

' _UNSIGNED _BYTE         ~%%                  0                              255                          1

' INTEGER                 %                    -32,768                        32,767                       2

' _UNSIGNED INTEGER       ~%                   0                              65,535                       2

' LONG                    &                    -2,147,483,648                 2,147,483,647                4

' _UNSIGNED LONG          ~&                   0                              4,294,967,295                4

' _INTEGER64              &&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    8

' _UNSIGNED _INTEGER64    ~&&                  0                              18,446,744,073,709,551,615   8

' SINGLE                  ! or none            -2.802597E-45                  +3.402823E+38                4

' DOUBLE                  #                    -4.490656458412465E-324        +1.797693134862310E+308      8

' _FLOAT                  ##                   -1.18E-4932                    +1.18E+4932                  32(10 used)

' _OFFSET                 %&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    Use LEN

' _UNSIGNED _OFFSET       ~%&                  0                              18,446,744,073,709,551,615   Use LEN

' _MEM                    none                 combined memory variable type  N/A                          Use LEN



' div: int1% = num1% \ den1%

' mod: rem1% = num1% MOD den1%