12-16-2024, 03:58 PM
After my initial post, I got busy and this just sat on the backburner. Finally I asked ChatGPT to take a crack at it, and although it didn't produce a working program, it did at least provide a basic program structure to help jump start this, which has led to a "beta" version. The attached ZIP file contains some test images and a sample output... It needs tweaking for calculating the number of rows (added an extra blank row at the bottom), handling images of different sizes and orientations, generating staggered layouts, etc. Screen shots and source code below...
![[Image: screenshot2.png]](https://i.ibb.co/Pj24g6n/screenshot2.png)
![[Image: screenshot1.png]](https://i.ibb.co/RDSc6Yw/screenshot1.png)
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%
/ usenet) where people would create thumbnail images of their collections with filename and then other people could request them to post to the newsgroup specific files 