Introduction
This complete Windows application lets you merge image and PDF files in a given folder into one PDF file. It also lets you password protect the PDF file. It uses free iTextSharp library.
Using the code
To use this program, simply select a folder and click Process. The program will create a PDF file within each folder and subfolder. The file will have the same name as the folder plus the PDF extension.
Here is the code:
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
cbFileType.SelectedIndex = 0
End Sub
Private Sub btnFrom_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFrom.Click
fldFrom.SelectedPath = txtFrom.Text
fldFrom.ShowDialog()
txtFrom.Text = fldFrom.SelectedPath
End Sub
Private Sub btnProcess_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnProcess.Click
btnProcess.Enabled = False
Dim sFromPath As String = txtFrom.Text
If Not Directory.Exists(sFromPath) Then
btnProcess.Enabled = True
MsgBox("Folder does not exist")
Exit Sub
End If
txtOutput.Text = ""
txtOutput.Text += "Starting..." & vbCrLf
ProccessFolder(sFromPath)
txtOutput.Text += "Done!"
btnProcess.Enabled = True
End Sub
Private Function PadExt(ByVal s As String) As String
s = UCase(s)
If s.Length > 3 Then
s = s.Substring(1, 3)
End If
Return s
End Function
Function GetPageCount(ByVal sFolderPath As String) As Integer
Dim iRet As Integer = 0
Dim oFiles As String() = Directory.GetFiles(sFolderPath)
For i As Integer = 0 To oFiles.Length - 1
Dim sFromFilePath As String = oFiles(i)
Dim oFileInfo As New FileInfo(sFromFilePath)
Dim sFileType As String = cbFileType.SelectedItem
Dim sExt As String = PadExt(oFileInfo.Extension)
Select Case sFileType
Case "All"
If sExt = "PDF" Then
iRet += 1
ElseIf sExt = "JPG" Or sExt = "TIF" Then
iRet += 1
End If
Case "PDF"
If sExt = "PDF" Then
iRet += 1
End If
Case "JPG", "TIF"
If sExt = "JPG" Or sExt = "TIF" Then
iRet += 1
End If
End Select
Next
Return iRet
End Function
Sub ProccessFolder(ByVal sFolderPath As String)
Dim bOutputfileAlreadyExists As Boolean = False
Dim oFolderInfo As New System.IO.DirectoryInfo(sFolderPath)
Dim sOutFilePath As String = sFolderPath & "\" & oFolderInfo.Name & ".pdf"
If chkCreateInParentFolder.Checked Then
sOutFilePath = oFolderInfo.Parent.FullName & "\" & oFolderInfo.Name & ".pdf"
End If
If IO.File.Exists(sOutFilePath) Then
Try
IO.File.Delete(sOutFilePath)
Catch ex As Exception
txtOutput.Text += "Output file already exists: " & sOutFilePath & _
" and could not be deleted." & vbTab & vbCrLf
bOutputfileAlreadyExists = True
End Try
End If
Dim iPageCount As Integer = GetPageCount(sFolderPath)
If iPageCount > 0 And bOutputfileAlreadyExists = False Then
txtOutput.Text += "Processing folder: " & sFolderPath & " - " & iPageCount & " files." & vbCrLf
Dim oFiles As String() = Directory.GetFiles(sFolderPath)
ProgressBar1.Maximum = oFiles.Length
Dim oPdfDoc As New iTextSharp.text.Document()
Dim oPdfWriter As PdfWriter = PdfWriter.GetInstance(oPdfDoc, New FileStream(sOutFilePath, FileMode.Create))
If txtPassword.Text <> "" Then
oPdfWriter.SetEncryption(PdfWriter.STRENGTH40BITS, txtPassword.Text, txtPassword.Text, PdfWriter.AllowCopy)
End If
oPdfDoc.Open()
System.Array.Sort(Of String)(oFiles)
For i As Integer = 0 To oFiles.Length - 1
Dim sFromFilePath As String = oFiles(i)
Dim oFileInfo As New FileInfo(sFromFilePath)
Dim sFileType As String = cbFileType.SelectedItem
Dim sExt As String = PadExt(oFileInfo.Extension)
Try
Select Case sFileType
Case "All"
If sExt = "PDF" Then
AddPdf(sFromFilePath, oPdfDoc, oPdfWriter)
ElseIf sExt = "JPG" Or sExt = "TIF" Then
AddImage(sFromFilePath, oPdfDoc, oPdfWriter, sExt)
End If
Case "PDF"
If sExt = "PDF" Then
AddPdf(sFromFilePath, oPdfDoc, oPdfWriter)
End If
Case "JPG", "TIF"
If sExt = "JPG" Or sExt = "TIF" Then
AddImage(sFromFilePath, oPdfDoc, oPdfWriter, sExt)
End If
End Select
Catch ex As Exception
txtOutput.Text += sFromFilePath & vbTab & ex.Message & vbCrLf
End Try
If chkDeleteSourceFiles.Checked And IO.File.Exists(sFromFilePath) Then
Try
IO.File.Delete(sFromFilePath)
Catch ex As Exception
txtOutput.Text += "Could not delete " & sFromFilePath & _
", " & ex.Message & vbCrLf
End Try
End If
ProgressBar1.Value = i
Next
Try
oPdfDoc.Close()
oPdfWriter.Close()
Catch ex As Exception
txtOutput.Text += ex.Message & vbCrLf
Try
IO.File.Delete(sOutFilePath)
Catch ex2 As Exception
End Try
End Try
ProgressBar1.Value = 0
End If
Dim oFolders As String() = Directory.GetDirectories(sFolderPath)
For i As Integer = 0 To oFolders.Length - 1
Dim sChildFolder As String = oFolders(i)
Dim iPos As Integer = sChildFolder.LastIndexOf("\")
Dim sFolderName As String = sChildFolder.Substring(iPos + 1)
ProccessFolder(sChildFolder)
Next
End Sub
Sub AddBookmark(ByRef oPdfDoc As iTextSharp.text.Document, ByVal sFromFilePath As String)
If chkBookmarks.Checked = False Then
Exit Sub
End If
Dim oChapter As New iTextSharp.text.Chapter("", 0)
oChapter.NumberDepth = 0
Dim oFileInfo As New FileInfo(sFromFilePath)
oChapter.BookmarkTitle = oFileInfo.Name
oPdfDoc.Add(oChapter)
End Sub
Sub AddPdf(ByVal sInFilePath As String, ByRef oPdfDoc As iTextSharp.text.Document, ByRef oPdfWriter As PdfWriter)
AddBookmark(oPdfDoc, sInFilePath)
Dim oDirectContent As iTextSharp.text.pdf.PdfContentByte = oPdfWriter.DirectContent
Dim oPdfReader As iTextSharp.text.pdf.PdfReader = New iTextSharp.text.pdf.PdfReader(sInFilePath)
Dim iNumberOfPages As Integer = oPdfReader.NumberOfPages
Dim iPage As Integer = 0
Do While (iPage < iNumberOfPages)
iPage += 1
Dim iRotation As Integer = oPdfReader.GetPageRotation(iPage)
Dim oPdfImportedPage As iTextSharp.text.pdf.PdfImportedPage = oPdfWriter.GetImportedPage(oPdfReader, iPage)
If chkResize.Checked Then
If (oPdfImportedPage.Width <= oPdfImportedPage.Height) Then
oPdfDoc.SetPageSize(iTextSharp.text.PageSize.LETTER)
Else
oPdfDoc.SetPageSize(iTextSharp.text.PageSize.LETTER.Rotate())
End If
oPdfDoc.NewPage()
Dim iWidthFactor As Single = oPdfDoc.PageSize.Width / oPdfReader.GetPageSize(iPage).Width
Dim iHeightFactor As Single = oPdfDoc.PageSize.Height / oPdfReader.GetPageSize(iPage).Height
Dim iFactor As Single = Math.Min(iWidthFactor, iHeightFactor)
Dim iOffsetX As Single = (oPdfDoc.PageSize.Width - (oPdfImportedPage.Width * iFactor)) / 2
Dim iOffsetY As Single = (oPdfDoc.PageSize.Height - (oPdfImportedPage.Height * iFactor)) / 2
oDirectContent.AddTemplate(oPdfImportedPage, iFactor, 0, 0, iFactor, iOffsetX, iOffsetY)
Else
oPdfDoc.SetPageSize(oPdfReader.GetPageSizeWithRotation(iPage))
oPdfDoc.NewPage()
If (iRotation = 90) Or (iRotation = 270) Then
oDirectContent.AddTemplate(oPdfImportedPage, 0, -1.0F, 1.0F, 0, 0, oPdfReader.GetPageSizeWithRotation(iPage).Height)
Else
oDirectContent.AddTemplate(oPdfImportedPage, 1.0F, 0, 0, 1.0F, 0, 0)
End If
End If
Loop
End Sub
Sub AddImage(ByVal sInFilePath As String, ByRef oPdfDoc As iTextSharp.text.Document, ByRef oPdfWriter As PdfWriter, ByVal sExt As String)
AddBookmark(oPdfDoc, sInFilePath)
If chkResize.Checked = False Then
Dim oDirectContent As iTextSharp.text.pdf.PdfContentByte = oPdfWriter.DirectContent
Dim oPdfImage As iTextSharp.text.Image
oPdfImage = iTextSharp.text.Image.GetInstance(sInFilePath)
oPdfImage.SetAbsolutePosition(1, 1)
oPdfDoc.SetPageSize(New iTextSharp.text.Rectangle(oPdfImage.Width, oPdfImage.Height))
oPdfDoc.NewPage()
oDirectContent.AddImage(oPdfImage)
Exit Sub
End If
Dim oImage As System.Drawing.Image = System.Drawing.Image.FromFile(sInFilePath)
If sExt = "TIF" Then
Dim iPageCount As Integer = oImage.GetFrameCount(Imaging.FrameDimension.Page)
If iPageCount > 1 Then
For iPage As Integer = 0 To iPageCount - 1
oImage.SelectActiveFrame(Imaging.FrameDimension.Page, iPage)
Dim oMemoryStream As New IO.MemoryStream()
oImage.Save(oMemoryStream, System.Drawing.Imaging.ImageFormat.Png)
Dim oImage2 As System.Drawing.Image = System.Drawing.Image.FromStream(oMemoryStream)
AddImage2(oImage2, oPdfDoc, oPdfWriter)
oMemoryStream.Close()
Next
Exit Sub
End If
End If
AddImage2(oImage, oPdfDoc, oPdfWriter)
oImage.Dispose()
End Sub
Sub AddImage2(ByRef oImage As System.Drawing.Image, ByRef oPdfDoc As iTextSharp.text.Document, ByRef oPdfWriter As PdfWriter)
Dim oDirectContent As iTextSharp.text.pdf.PdfContentByte = oPdfWriter.DirectContent
Dim oPdfImage As iTextSharp.text.Image
Dim iWidth As Single = oImage.Width
Dim iHeight As Single = oImage.Height
Dim iAspectRatio As Double = iWidth / iHeight
Dim iWidthPage As Single = 0
Dim iHeightPage As Single = 0
If iAspectRatio < 1 Then
iWidthPage = iTextSharp.text.PageSize.LETTER.Width
iHeightPage = iTextSharp.text.PageSize.LETTER.Height
Else
iHeightPage = iTextSharp.text.PageSize.LETTER.Width
iWidthPage = iTextSharp.text.PageSize.LETTER.Height
End If
Dim iPageAspectRatio As Double = iWidthPage / iHeightPage
Dim iWidthGoal As Single = 0
Dim iHeightGoal As Single = 0
Dim bFitsWithin As Boolean = False
If iWidth < iWidthPage And iHeight < iHeightPage Then
bFitsWithin = True
iWidthGoal = iWidth
iHeightGoal = iHeight
ElseIf iAspectRatio > iPageAspectRatio Then
iWidthGoal = iWidthPage
iHeightGoal = iWidthPage * (iHeight / iWidth)
Else
iWidthGoal = iHeightPage * (iWidth / iHeight)
iHeightGoal = iHeightPage
End If
If bFitsWithin = False Then
oImage = FixedSize(oImage, iWidthGoal, iHeightGoal)
End If
oPdfImage = iTextSharp.text.Image.GetInstance(oImage, System.Drawing.Imaging.ImageFormat.Png)
oPdfImage.SetAbsolutePosition(1, 1)
If iAspectRatio < 1 Then
oPdfDoc.SetPageSize(iTextSharp.text.PageSize.LETTER)
Else
oPdfDoc.SetPageSize(iTextSharp.text.PageSize.LETTER.Rotate())
End If
oPdfDoc.NewPage()
oPdfImage.ScaleAbsolute(iWidthGoal, iHeightGoal)
oDirectContent.AddImage(oPdfImage)
End Sub
Private Function FixedSize(ByVal imgPhoto As System.Drawing.Image, _
ByVal Width As Integer, ByVal Height As Integer) As System.Drawing.Image
If txtResizeResolution.Text = "" OrElse IsNumeric(txtResizeResolution.Text) = False Then
txtOutput.Text += "Resize Resolution is not a number."
Return imgPhoto
End If
Dim iResizeResolution As Double = CDbl(txtResizeResolution.Text) / 100
Width = Width * iResizeResolution
Height = Height * iResizeResolution
Dim sourceWidth As Integer = imgPhoto.Width
Dim sourceHeight As Integer = imgPhoto.Height
Dim sourceX As Integer = 0
Dim sourceY As Integer = 0
Dim destX As Integer = 0
Dim destY As Integer = 0
Dim nPercent As Single = 0
Dim nPercentW As Single = 0
Dim nPercentH As Single = 0
nPercentW = (CSng(Width) / CSng(sourceWidth))
nPercentH = (CSng(Height) / CSng(sourceHeight))
If nPercentH < nPercentW Then
nPercent = nPercentH
destX = CInt(((Width - (sourceWidth * nPercent)) / 2))
Else
nPercent = nPercentW
destY = CInt(((Height - (sourceHeight * nPercent)) / 2))
End If
Dim destWidth As Integer = CInt((sourceWidth * nPercent))
Dim destHeight As Integer = CInt((sourceHeight * nPercent))
Dim bmPhoto As New Bitmap(Width, Height, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
bmPhoto.SetResolution(imgPhoto.HorizontalResolution, imgPhoto.VerticalResolution)
Dim grPhoto As Graphics = Graphics.FromImage(bmPhoto)
grPhoto.Clear(Color.White)
grPhoto.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
grPhoto.DrawImage(imgPhoto, New Rectangle(destX, destY, destWidth, destHeight), _
New Rectangle(sourceX, sourceY, sourceWidth, sourceHeight), GraphicsUnit.Pixel)
grPhoto.Dispose()
imgPhoto.Dispose()
Return bmPhoto
End Function
