The relevant code follows:
- Code: Select all
'Set original PDF object
Dim original As New PdfDocument
Try
original.LoadFromFile(FileName)
Catch ex As Exception
MsgBox("Failed to open PDF" + vbNewLine + ex.Message)
Exit Sub
End Try
'Create blank PDF for destination file
Dim doc As New PdfDocument()
'Create Page Objects for Original and New PDF
Dim page As PdfPageBase 'New
Dim originalPage As PdfPageBase 'Original
For Each originalPage In original.Pages
page = doc.Pages.Add(PdfPageSize.A4, New PdfMargins(0))
InsertText(page, BatesNumberStart)
If Not watermark = "NONE" Then InsertWatermark(page, watermark)
originalPage.CreateTemplate().Draw(page, 0, 0)
Next
The Insertwatermark sub works but the pasting of the original document messes up after using it. I am surmising that something related to the size or sizing of the page is being altered in the InsertWatermark sub, but I am not sure how to fix it.
InsertWatermark sub text:
- Code: Select all
Private Sub InsertWatermark(ByVal page As PdfPageBase, ByVal watermark As String)
Dim brush As New PdfTilingBrush(New SizeF(page.Canvas.ClientSize.Width / 2, page.Canvas.ClientSize.Height / 3))
brush.Graphics.SetTransparency(0.3F)
brush.Graphics.Save()
brush.Graphics.TranslateTransform(brush.Size.Width / 2, brush.Size.Height / 2)
brush.Graphics.RotateTransform(-45)
brush.Graphics.DrawString(watermark, New PdfFont(PdfFontFamily.Helvetica, 24), PdfBrushes.Violet, 0, 0, New PdfStringFormat(PdfTextAlignment.Center))
brush.Graphics.Restore()
brush.Graphics.SetTransparency(1)
page.Canvas.DrawRectangle(brush, New RectangleF(New PointF(0, 0), page.Canvas.ClientSize))
End Sub
