Resizing existing pdfpage not top centered - pdf

All,
I am trying to resize an existing PDF file but the result is not centered, what am I doing wrong? I am using PDFsharp, please see below code:
Private Sub ResizePDF(sourcePDF As String, outPDF As String)
Dim form As XPdfForm = XPdfForm.FromFile(sourcePDF)
Dim doc2 As New PdfSharp.Pdf.PdfDocument()
doc2.Options.CompressContentStreams = True
doc2.Options.ColorMode = PdfSharp.Pdf.PdfColorMode.Rgb
For pagenumber As Integer = 1 To (form.PageCount + 1) - 1
Dim page As PdfSharp.Pdf.PdfPage = doc2.Pages.Add()
form.PageNumber = pagenumber
page.Width = form.PixelWidth + 15.36
page.Height = form.PixelHeight + 40.32
Dim graph As XGraphics = XGraphics.FromPdfPage(page)
Dim rect As New XRect(0, 0, page.Width, page.Height)
graph.DrawImage(form, rect)
Next
If IO.Directory.Exists(IO.Path.GetDirectoryName(outPDF)) = False Then IO.Directory.CreateDirectory(IO.Path.GetDirectoryName(outPDF))
doc2.Save(outPDF)
End Sub
Input file: https://www.dropbox.com/s/po87x8c44r90py2/HFD_20151007_0_001_061.pdf?dl=0
Ouput File: https://www.dropbox.com/s/pt5pcyfayri6ory/HFD_20151007_0_001_061_output.pdf?dl=0

We have a workaround for you: Instead of calling graph.DrawImage(form, rect) please call
graph.DrawImage(form, rect.X - form.Page.MediaBox.X1, rect.Y + form.Page.MediaBox.Y1, rect.Width, rect.Height).
I'm not sure if this is valid VB.NET, but it works in C# and should work for VB.NET with little or no changes.
This is a workaround needed for PDFsharp 1.50 beta 2 and all earlier versions.
When switching to PDFsharp 1.50 beta 3 or a later version (not yet available), you will have to use the initial code graph.DrawImage(form, rect) again.

Related

The cropping area has an x and y offset in the new bitmap, but only if the original has been scaled

a strange phenomenon occurs.
With my edge detection program, I can transfer the inside of the GraphicsPath to a new image.
It always works great – except when I scale the original image with GIMP and Word (aspect ratio remains, only the dimensions are changed). Then the area is shifted. To the left and up. See attachement. In line 68, I looked what is in rectCutout. Everything OK.
Does this have anything to do with GIMP? The dots per inch are the same (72). The compression quality of the JPEG also (100%).
I just realized: if I scale an image larger, the result is completely black.
The strange thing is: I'm not saying: the picture that is drawn on is larger than the picture that is saved. Then it would be logical that the path is not in the same position. It's about the fact that the loaded image is just smaller.
I would be happy if someone could tell me why. 😄
this is the scaled image which is loaded
Here you see the GUI, ready to save
cropped image, area has x and y offset
#Disable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
Imports System.Drawing.Drawing2D
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class AllesGrafische
Public Shared Sub Paint_the_Rectangle(ByVal g As Graphics, ByVal recta As Rectangle)
If g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Using Pen_Hellblau As Pen = New Pen(Color.FromArgb(0, 200, 255), 1.0F)
g.DrawRectangle(Pen_Hellblau, recta)
End Using
End If
End Sub
Public Shared Sub Draw_Curve(ByVal g As Graphics, ByVal theList As List(Of Point))
If theList IsNot Nothing AndAlso theList.Count > 0 AndAlso g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Dim theList_neu As New List(Of Point)
Using gp As New GraphicsPath
For i As Integer = 1 To theList.Count - 1 Step 1
Dim a As Integer = theList(i).X
Dim b As Integer = theList(i).Y
Dim c As Integer = theList(i - 1).X
Dim d As Integer = theList(i - 1).Y
Dim Entfernungsbetrag As Double = Math.Sqrt(Math.Pow(a, 2) + Math.Pow(b, 2) + Math.Pow(c, 2) + Math.Pow(d, 2) - 2 * a * c - 2 * b * d)
If Entfernungsbetrag < Form1.erlaubte_Entfernung Then
theList_neu.Add(theList(i))
End If
Next
If theList_neu.Count = 0 Then Return
gp.AddLines(theList_neu.ToArray())
Using Pen_hellrosa As Pen = New Pen(Color.FromArgb(255, 64, 239), 1.0F)
g.DrawPath(Pen_hellrosa, gp)
End Using
If Form1.ClosePath Then
gp.CloseFigure()
End If
If Form1.CheckBox1.Checked Then
Dim Speicherpfad As String
Using SFD1 As New CommonSaveFileDialog
SFD1.Title = "Wo soll das Bild gespeichert werden?"
SFD1.Filters.Add(New CommonFileDialogFilter("PNG", ".png"))
If System.IO.Directory.Exists("C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen") Then
SFD1.InitialDirectory = "C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen"
Else
SFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
End If
If SFD1.ShowDialog = CommonFileDialogResult.Ok Then
Speicherpfad = SFD1.FileName & ".png"
Else
Return
End If
End Using
Using bmpSource As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As Matrix = New Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
Using graphicsCutout As Graphics = Graphics.FromImage(bmpCutout)
graphicsCutout.Clip = New Region(gp)
graphicsCutout.DrawImage(bmpSource, CInt(-rectCutout.Left), CInt(-rectCutout.Top))
bmpCutout.Save(Speicherpfad, Imaging.ImageFormat.Png)
Form1.CheckBox1.Checked = False
End Using
End Using
End Using
End If
End Using
End If
End Sub
End Class
#Enable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
The solution is to use .SetResolution()
Using Original As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As System.Drawing.Drawing2D.Matrix = New System.Drawing.Drawing2D.Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
bmpCutout.SetResolution(Original.HorizontalResolution, Original.VerticalResolution)
.
.
.
.
.

Footer and Watermark added by iTextSharp not appearing in Edge but OK in Chrome

I create pdfs using iTextSharp and add a footnote and watermark to these using a PdfStamper. This has been working fine. Recently the footers and watermarks have not been appearing when the pdfs are viewed in MS Edge. However, if I view the same pdf in Chrome the footers and watermarks appear correctly.
I store the pdfs in blob storage in Azure.
I have recently changed iTextSharp version from V4.1.2.0 to V5.5.13.
The code for adding watermarks and footers is as follows:
Dim byteArray As Byte()
Using stream As MemoryStream = New MemoryStream
reportBlockBlob.DownloadToStream(stream)
reader = New PdfReader(CType(stream.ToArray(), Byte()))
If reader IsNot Nothing Then
Using stamper As PdfStamper = New PdfStamper(reader, stream)
Dim PageCount As Integer = reader.NumberOfPages
If bReportInvalid Then
For i As Integer = 1 To PageCount
StampWaterMark(stamper, i, "INVALID", fontReport60, 35, New text.BaseColor(70, 70, 255), reader.GetPageSizeWithRotation(i))
Next
ElseIf Not UserRoles.Contains(WaspWAVB.con.csUserRoleCertificateSignOff) Then
For i As Integer = 1 To PageCount
StampWaterMark(stamper, i, "DRAFT", fontReport60, 35, New text.BaseColor(70, 70, 255), reader.GetPageSizeWithRotation(i))
Next
End If
If bAddFooter Then
Dim sRepUCN As String = "UCN"
Dim sCopyright As String = "Copyright"
Dim yPos As Integer = 12
Dim xLeftPos As Integer = 36
Dim xMidPos As Single = 297.5
Dim xRightPos As Integer = 559
For i As Integer = 3 To PageCount - iAppendixCount
ColumnText.ShowTextAligned(stamper.GetOverContent(i), text.Element.ALIGN_LEFT, New text.Phrase(sRepUCN, fontMedium), xLeftPos, yPos, 0)
ColumnText.ShowTextAligned(stamper.GetOverContent(i), text.Element.ALIGN_CENTER, New text.Phrase(sCopyright, fontMedium), xMidPos, yPos, 0)
Dim rttnPg As Integer = reader.GetPageRotation(i)
If rttnPg <> 0 Then
xRightPos = 806
End If
ColumnText.ShowTextAligned(stamper.GetOverContent(i), text.Element.ALIGN_RIGHT, New text.Phrase(String.Format(WaspWAVB.con.csPageXofY, i - 2, PageCount - 2 - iAppendixCount), fontMedium), xRightPos, yPos, 0)
Next
End If
End Using
byteArray = stream.ToArray()
End If
End Using
reportBlockBlob.Properties.ContentType = "application/pdf"
reportBlockBlob.UploadFromByteArray(byteArray, 0, byteArray.Length)
Public Shared Sub StampWaterMark(ByRef stamper As PdfStamper,
ByVal i As Integer,
ByVal watermark As String,
ByVal font As text.Font,
ByVal angle As Single,
ByVal color As text.BaseColor,
ByVal realPageSize As text.Rectangle,
Optional ByVal rect As text.Rectangle = Nothing)
Dim gstate = New PdfGState()
gstate.FillOpacity = 0.1F
gstate.StrokeOpacity = 0.3F
stamper.GetOverContent(i).SaveState()
stamper.GetOverContent(i).SetGState(gstate)
stamper.GetOverContent(i).SetColorFill(color)
stamper.GetOverContent(i).BeginText()
Dim ps = If(rect, realPageSize)
Dim x = (ps.Right + ps.Left) / 2
Dim y = (ps.Bottom + ps.Top) / 2
ColumnText.ShowTextAligned(stamper.GetOverContent(i), text.Element.ALIGN_CENTER, New text.Phrase(watermark, font), x, y, angle)
End Sub
I have tried re-arranging the order in which the footer and watermark are applied and commenting out either the addition of watermark or footer. None of this helps.
I use the code to add a footer elsewhere in the code and this works. Where it works, the footer is applied to an individual page. Where it doesn't work I have just collected together pages stored in separate blobs and amalgamated them into one memorystream. The footer and watermark are applied to this.
What is mystifying is that the pdf works fine in Chrome but not in Edge. This works either way round - i.e. if I create it in Chrome and view it in Edge, the footers disappear and if I create it in Edge and view it in Chrome, the footers appear.
Has anyone else seen this problem and knows how to solve it?

Vb.net image mask making smooth along the edges

Hey all i am trying to get my images to look nice and smooth (antialiasing) from using a mask in order to make the round image as you see below:
The original image looks like this:
The mask for the image above looks like this (the red being the mask color to take out):
It works but it gives me those not-so-nice jagged edges around it. The mask is an .png and also the image itself is a .png.
The code i use to make the mask is this:
picNextTopic1.Image = Image.FromStream(wc.OpenRead(anAPI.wallOrgPostImage(keying).Replace("{width}", "50").Replace("{height}", "50"))) 'Download the image from the website.
picNextTopic1.Image = ApplyMask(New Bitmap(picNextTopic1.Image), New Bitmap(My.Resources.mask), Color.Red) 'Apply mask to the downloaded image above.
The ApplyMask function is this:
Public Function ApplyMask(ByVal bImg As Bitmap, ByVal bMask As Bitmap, ByVal maskColor As Color) As Image
Dim wImg As Integer = bImg.Width
Dim hImg As Integer = bImg.Height
Dim wMask As Integer = bMask.Width
Dim hMask As Integer = bMask.Height
Dim intMask As Integer = maskColor.ToArgb
Dim intTransparent As Integer = Color.Transparent.ToArgb
Using fpImg As New FastPix(bImg)
Using fpMask As New FastPix(bMask)
Dim pixelsImg = fpImg.PixelArray
Dim pixelsMask = fpMask.PixelArray
For y As Integer = 0 To Math.Min(hImg, hMask) - 1
For x As Integer = 0 To Math.Min(wImg, wMask) - 1
Dim iImg As Integer = (y * wImg) + x
Dim iMask As Integer = (y * wMask) + x
If pixelsMask(iMask) = intMask Then
pixelsImg(iImg) = intTransparent
End If
Next
Next
End Using
End Using
Return bImg
End Function
Which uses FastPix found here.
Any help to smooth this out would be great! Thanks!
UPDATE
code for transparent form that i have:
Public Sub InitializeMyForm()
BackColor = Color.Plum
TransparencyKey = BackColor
End Sub
Playing around with this, I did manage to make a smooth image this way using a TextureBrush:
Dim profile As Image = Image.FromFile("c:\...\profile.png")
Protected Overrides Sub OnPaint(e As PaintEventArgs)
e.Graphics.Clear(Color.SteelBlue)
e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
Using tb As New TextureBrush(profile)
tb.TranslateTransform(120, 64)
Using p As New GraphicsPath
p.AddEllipse(120, 64, profile.Width, profile.Width)
e.Graphics.FillPath(tb, p)
End Using
End Using
MyBase.OnPaint(e)
End Sub
The TranslateTransform and the AddEllipse location use the same point information in order to "center" the texture brush appropriately.
The result:

ReportViewer.LocalReport.Render("PDF")

I am using Report Viewer for WinForms. The problem i am having is this: I have a form that contains a form which is used to view a local report which work fine, but when I try to render the same report as a PDF, it is cut-off, but in report viewer the same report renders a report on one page. When I render to PDF it cuts it off and the part of the report that was cut-off renders on a 2nd page. So in other words, part of the same report is on page 1, and 2nd half is on 2nd page in the PDF?
Code:
Private Function GetPDfReport() As String
Dim parameters = Me.GetReportParms()
Dim query = Me.GetReportQuery()
Dim rView As Microsoft.Reporting.WinForms.ReportViewer = New Microsoft.Reporting.WinForms.ReportViewer
rView.Dock = DockStyle.Fill
rView.SetDisplayMode(DisplayMode.PrintLayout)
Dim pnl As New Panel()
pnl.Name = "pnlMain"
pnl.Location = New System.Drawing.Point(0, 25)
pnl.Size = New System.Drawing.Size(734, 478)
pnl.Controls.Add(rView)
Dim dbReader As New dbReader()
Dim ds As DataSet = dbReader.DataSet(query)
Dim rds As Microsoft.Reporting.WinForms.ReportDataSource = New Microsoft.Reporting.WinForms.ReportDataSource("DataSet1", ds.Tables(0))
rView.ProcessingMode = Microsoft.Reporting.WinForms.ProcessingMode.Local
rView.LocalReport.DataSources.Add(rds)
rView.LocalReport.ReportEmbeddedResource = "EasyDose.rptIncident.rdlc"
If Not IsNothing(parameters) Then
Dim Bound0 As Integer = parameters.GetUpperBound(0)
Dim Bound1 As Integer = parameters.GetUpperBound(1)
For index = 0 To Bound0
Dim rParameter As New ReportParameter(parameters(index, 0), parameters(index, 1))
rView.LocalReport.SetParameters(rParameter)
Next
End If
Dim ps As PageSettings = rView.GetPageSettings
ps.Margins.Top = 0 ' 10mm approx
ps.Margins.Right = 0
ps.Margins.Bottom = 0
ps.Margins.Left = 0
ps.Landscape = False
'ps.PaperSize = New PaperSize("LetterExtra", (9.275 * 100), (12 * 100)) ' Letter paper (8.5 in. by 11 in.) ' Letter extra paper (9.275 in. by 12 in.)
ps.PaperSize = New PaperSize("A4", (8.27 * 100), (11.69 * 100))
rView.RefreshReport()
Dim exePath As String = System.IO.Path.GetDirectoryName(Application.ExecutablePath)
Dim dir As New DirectoryInfo(System.IO.Path.Combine(exePath, "tmpDir"))
Dim file As New FileInfo(System.IO.Path.Combine( _
dir.FullName, String.Format("Patient_Details_{0:yyyyMMdd_hhmmss}.pdf", DateTime.Now)))
If Not dir.Exists Then
dir.Create()
End If
Dim bytes As Byte() = rView.LocalReport.Render("PDF")
Using fs As New System.IO.FileStream(file.FullName, System.IO.FileMode.Create)
fs.Write(bytes, 0, bytes.Length)
fs.Close()
End Using
Return file.FullName
End Function
are you seeing the local report in the embedded ReportViewer using the "Print Layout" option activated? That should show exactly the same output as your printed result.
If you have problems in the PDF is probably caused by the design of the report itself. Check the font, the page size and orientation, the margins, the page breaks.
uisng System.IO;
byte[] rep = reportViewer1.LocalReport.Render("pdf", deviceInfo: "");
// if a certificate warning appears just ignore and re-run
File.WriteAllBytes(filepath+filename+".pdf",rep);

Unable to position form to center

I have a form called Form1. Its set to startup-Position = Center but when executed it opens up somewhere else (At a random position evrytime).
I am working under Windows XP SP3 , using IDE Visual Studio - 2010. Please provide a workaround to this problem.
I have uploaded a sample project showing the above mentioned problem .
Download link:
http://www.6ybh-upload.com/vt5i4z1wz9pl/Light.zip
You have to set:
Form1.StartPosition = FormStartPosition.Manual
Edit:
Here is a working sample:
Dim X As Integer = (Screen.PrimaryScreen.Bounds.Width - Me.Width) / 2
Dim Y As Integer = (Screen.PrimaryScreen.Bounds.Height - Me.Height) / 2
Me.StartPosition = FormStartPosition.Manual
Me.Location = New System.Drawing.Point(X, Y)
Edit 2:
Here is the improved code based on comments by Hans Passant, (much better):
Dim mainScreen As Screen = Screen.FromPoint(Me.Location)
Dim X As Integer = (mainScreen.WorkingArea.Width - Me.Width) / 2 + mainScreen.WorkingArea.Left
Dim Y As Integer = (mainScreen.WorkingArea.Height - Me.Height) / 2 + mainScreen.WorkingArea.Top
Me.StartPosition = FormStartPosition.Manual
Me.Location = New System.Drawing.Point(X, Y)
Try to use this after resize the screen
Me.Size = New System.Drawing.Size(800, 436)
Me.CenterToScreen()
In your question it isn't quite clear what you have actually tried since there is no such option as "Center" for the StartPosition property of a Form.
However, setting StartPosition to CenterScreen or
Me.StartPosition = FormStartPosition.CenterScreen
if you are doing it programmatically, should get you exactly what you need.
Reference: http://msdn.microsoft.com/en-us/library/system.windows.forms.formstartposition.aspx
Here is the solution:
Dim screen__1 As Screen = Screen.FromControl(frm)
Dim workingArea As Rectangle = screen__1.WorkingArea
frm.Location = New Point() With { _
.X = Math.Max(workingArea.X, workingArea.X + (workingArea.Width - frm.Width) / 2), _
.Y = Math.Max(workingArea.Y, workingArea.Y + (workingArea.Height - frm.Height) / 2) _
}
The Second One:
'frm = is the form object
Dim X As Integer = (Screen.PrimaryScreen.Bounds.Width - frm.Width) / 2
Dim Y As Integer = (Screen.PrimaryScreen.Bounds.Height - frm.Height) / 2
frm.StartPosition = FormStartPosition.Manual
frm.Location = New System.Drawing.Point(X, Y)
For VB.net 2010
put code to form load event
Call CenterToScreen()
this is built in method provided by VS