Option Explicit

Private bCancel As Boolean

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub Drive1_Change()
    On Error GoTo ErrorHandler
    Dim backup_path As String
    backup_path = DirList.path
    DirList.path = Drive1.Drive
    Exit Sub
ErrorHandler:
    DirList.path = backup_path
    MsgBox (Err.Description)
End Sub


Private Sub OKButton_Click()
    If OKButton.Caption = "Create" Then
        Call DoIt(DirList.path, CStr(heightTextBox.Text), CStr(WidthTextBox.Text), 24, 22)
    Else
        bCancel = True
    End If
End Sub
Rem this routine iterates through all images in the folder and creates a named
Rem THumb nail for each of these
Sub DoIt(sDirName As String, verticalCount, horizontalCount As Integer, _
         horizontalSpacing, verticalSpacing As Double)
        
        ' Create the Application object and get a set of image files to work with
        Dim oTheFiles As Collection
        Dim oTheApp As Illustrator.Application
        Dim oTheDocument As Illustrator.Document
        
        Set oTheFiles = GetFiles(sDirName)
        Set oTheApp = CreateObject("Illustrator.Application")
        Set oTheDocument = oTheApp.Documents.Add
        
            ' Determine the dimensions of the document
            Dim docLeft, docTop, printableWidth, printableHeight As Double
            
            docLeft = oTheDocument.PageOrigin(0)
            docTop = oTheDocument.Height - oTheDocument.PageOrigin(1)
            printableWidth = oTheDocument.Width - docLeft * 2
            printableHeight = oTheDocument.Height - oTheDocument.PageOrigin(1) * 2
        
            ' Calculate the size of the individual grid spaces that the images will be placed in
            Dim gridWidth, gridHeight As Double
            gridWidth = (printableWidth + horizontalSpacing) / horizontalCount
            gridHeight = (printableHeight + verticalSpacing) / verticalCount
        
            ' Calculate the size of the individual images based on the printable document area,
            ' and on the number of images to be placed across and down the page
            Dim imageWidth, imageHeight As Double
            imageWidth = gridWidth - horizontalSpacing
            imageHeight = gridHeight - verticalSpacing
            
            ' Normalize the image size so we end up with a square image
            Dim imageSize, xAdjustment, yAdjustment As Double
            If imageWidth < imageHeight Then
                imageSize = imageWidth
                xAdjustment = 0
                yAdjustment = (imageHeight - imageWidth) / 2
            Else
                imageSize = imageHeight
                xAdjustment = (imageWidth - imageHeight) / 2
                yAdjustment = 0
            End If
            
            ' Calculate the bounding box for the first image to be placed
            Dim imageLeft, imageRight, imageTop, imageBottom As Double
            imageLeft = docLeft + xAdjustment
            imageRight = imageLeft + imageSize
            
            imageTop = docTop - yAdjustment
            imageBottom = imageTop - imageSize
            
            ' Reset the cancel flag and modify the dialog
            bCancel = False
            ProgressBar.Max = oTheFiles.Count
            ProgressBar.Value = ProgressBar.Min
            ProgressBar.Enabled = True
            CancelButton.Enabled = False
            OKButton.Caption = "Cancel"
            
            ' Iterate over the images in the list, positioning then one at a time
            ' After they are positioned, place a border around then to make them stand out better
            Dim i As Integer
            i = 1
            Dim aFile
            For Each aFile In oTheFiles

                Call AddRasterItemToPage(oTheDocument, sDirName & "\" & aFile, imageLeft, imageTop, (imageSize))
                    
                Call MakeFramingRectangle(oTheDocument, imageLeft, imageTop, imageRight, imageBottom)
                
                Call MakeTextLabel(oTheDocument, CStr(aFile), imageLeft + imageSize / 2, imageBottom - 2#)
                
                ' Calculate a new image position for the next iteration of the loop
                If i Mod horizontalCount <> 0 Then
                    ' Not at the end of row yet, move to next position in the row
                    imageLeft = imageLeft + gridWidth
                    imageRight = imageRight + gridWidth
                Else
                    ' If at the end of a row, first check to see if we have run out of rows
                    If i / horizontalCount >= verticalCount Then
                        Exit For
                    End If
                    
                    imageLeft = docLeft + xAdjustment
                    imageRight = imageLeft + imageSize
                        
                    imageTop = imageTop - gridHeight
                    imageBottom = imageBottom - gridHeight
                End If
                
                ProgressBar.Value = i
                DoEvents
                If bCancel = True Then
                    Exit For
                End If
                i = i + 1
            Next
            
            ProgressBar.Value = 0
            ProgressBar.Enabled = False
            OKButton.Caption = "Create"
            CancelButton.Enabled = True
            
        Set oTheDocument = Nothing
        Set oTheApp = Nothing
        Set oTheFiles = Nothing
End Sub

Function GetFiles(path As String) As Collection
        Dim fso As New FileSystemObject, fls As Files, f As File
        Set fls = fso.GetFolder(path).Files
        Set GetFiles = New Collection
        For Each f In fls
            GetFiles.Add f.Name
        Next
        Exit Function
End Function

Sub MakeTextLabel(aDocument As Illustrator.Document, theText As String, _
                  xCenter, yVertPos As Double)
                          
        Dim aTextItem As TextArtItem
        Dim aTextRange As Illustrator.TextRange
        
        ' Create the new text label
        Set aTextItem = aDocument.TextArtItems.Add()
        aTextItem.Contents = theText
        aTextItem.Kind = aiPointText
        
        ' Calculate the final position and move the text label there
        aTextItem.Position = Array(xCenter - (aTextItem.Width / 2), yVertPos)

        
        ' Set the color of the text to default Illustrator color:
        ' No stroke & blanck fill
        Dim blackColor As New Illustrator.Color
        Dim blackCMYK As New Illustrator.CMYKColor
        blackCMYK.Black = 100
        blackCMYK.Cyan = 0
        blackCMYK.Magenta = 0
        blackCMYK.Yellow = 0
        blackColor.CMYK = blackCMYK
        
        Set aTextRange = aTextItem.TextRange
        aTextRange.Stroked = False
        aTextRange.Filled = True
        aTextRange.FillColor = blackColor
End Sub

Sub AddRasterItemToPage(aDocument As Illustrator.Document, filename As String, imageLeft, imageTop, imageSize As Double)
    On Error GoTo ErrorHandler
        Dim itemWidth, itemHeight As Double
        Dim X_ScaleFactor, Y_ScaleFactor, scaleFactor As Double
        Dim itemXoffset, itemYoffset As Double
        Dim aRasterItem As RasterItem
        
        ' Create a new raster item and link it to the image file
        Set aRasterItem = aDocument.RasterItems.Add()
        aRasterItem.File = filename
        
        ' Get the raster item dimensions
        itemWidth = aRasterItem.Width
        itemHeight = aRasterItem.Height
        
        ' Calculate the scale factors so the raster item can be fitted to the grid
        X_ScaleFactor = (imageSize / itemWidth) * 100
        Y_ScaleFactor = (imageSize / itemHeight) * 100
        
        ' Determine which of the scale factors to use
        If X_ScaleFactor < Y_ScaleFactor Then
            scaleFactor = X_ScaleFactor
        Else
            scaleFactor = Y_ScaleFactor
        End If
        
        ' Actually resize the raster item
        Call aRasterItem.Resize(scaleFactor, scaleFactor)
                
        ' Get the new raster item dimensions
        itemWidth = aRasterItem.Width
        itemHeight = aRasterItem.Height
        
        ' Move the raster item to the middle of its grid cell
        aRasterItem.Position = Array(imageLeft + (imageSize - itemWidth) / 2, _
                                     imageTop - (imageSize - itemHeight) / 2)
        
        Exit Sub
ErrorHandler:
    ' Ignoring errors - we will just get
    ' an empty box if this function failed
End Sub

Sub MakeFramingRectangle(aDocument As Illustrator.Document, left, top, right, bottom As Double)
        
        ' Add but not show the rectangle yet
        Dim myPath As PathItem
        Set myPath = aDocument.PathItems.Rectangle(top, left, right - left, top - bottom)
        myPath.Hidden = True
        
        ' Make a black color
        Dim blackColor As New Illustrator.Color
        Dim blackCMYK As New Illustrator.CMYKColor
        
        blackCMYK.Black = 100
        blackCMYK.Cyan = 0
        blackCMYK.Magenta = 0
        blackCMYK.Yellow = 0
        blackColor.CMYK = blackCMYK
        
        ' Set the Color to 100% black
        myPath.StrokeColor = blackColor
        
        ' Make sure it is not filled
        myPath.Filled = False
        
        ' Show the resulting path
        myPath.Hidden = False
End Sub