VB.NET Print Large Image on Multiple Pages - vb.net

i have a problem printing an large image over multiple Pages. I have scanned A4 Documents with 1-x Pages and they put together as one long image. I have to rescale Image to fit in width on A4 and to print with as many pages as on image are. There ist my code, can't achieve this, printing only first page. Any help woud be aprechiated. Thanks! (i'm a beginner...)
Imports System.Drawing.Printing
Imports System.Drawing.Imaging
Imports System.IO
Public Class Form1
Dim Bmp As Bitmap
dim pageNum As Int32 = 0
Private Sub PrintDocument4_PrintPage(ByVal sender As Object, ByVal e As PrintPageEventArgs) Handles PrintDocument4.PrintPage
Dim WidthRatio As Double = e.MarginBounds.Width / Bmp.Width
Dim maxpagenum As Int32 = Math.Ceiling(Bmp.Height / e.MarginBounds.Height * WidthRatio)
Debug.WriteLine(maxpagenum)
Debug.WriteLine(e.MarginBounds.Height)
Dim piece As New Bitmap(CInt(e.MarginBounds.Width / WidthRatio), CInt(e.MarginBounds.Height / WidthRatio))
Dim dest_rect As New Rectangle(0, 0, CInt(e.MarginBounds.Width / WidthRatio), CInt(e.MarginBounds.Height / WidthRatio))
Using gr As Graphics = Graphics.FromImage(piece)
Dim source_rect As New Rectangle(0, 0, CInt(e.MarginBounds.Width / WidthRatio), CInt(e.MarginBounds.Height / WidthRatio))
For i As Integer = 1 To maxpagenum
source_rect.X = 0
' Copy the piece of the image.
gr.DrawImage(Bmp, dest_rect, source_rect, _
GraphicsUnit.Pixel)
'piece.Save("Bmp" & i & ".jpg", ImageFormat.Bmp)
e.Graphics.DrawImage(piece, 0, source_rect.Y, CInt(piece.Width * WidthRatio), CInt(piece.Height * WidthRatio))
pageNum += 1
source_rect.Y += CInt(e.MarginBounds.Height / WidthRatio)
If pageNum < maxpagenum Then
e.HasMorePages = True
Else
pageNum = 0
End If
Next
End Using
End Sub
Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
If ListBox1.SelectedItem IsNot Nothing Then
Dim selItem As String = ListBox1.SelectedItem.ToString()
Dim fs1 As System.IO.FileStream
fs1 = New System.IO.FileStream(selItem, IO.FileMode.Open, IO.FileAccess.Read)
Bmp = New Bitmap(System.Drawing.Image.FromStream(fs1))
fs1.Close()
PrintDocument4 = New PrintDocument
With PrintDialog1
.AllowCurrentPage = False
.AllowPrintToFile = False
.AllowSelection = False
.AllowSomePages = False
.Document = PrintDocument4
.PrinterSettings.DefaultPageSettings.Margins.Top = 15
.PrinterSettings.DefaultPageSettings.Margins.Bottom = 15
.PrinterSettings.DefaultPageSettings.Margins.Left = 15
.PrinterSettings.DefaultPageSettings.Margins.Right = 15
End With
If PrintDialog1.ShowDialog = DialogResult.OK Then
PrintDocument4.PrinterSettings = PrintDialog1.PrinterSettings
AddHandler PrintDocument4.PrintPage, AddressOf PrintDocument4_PrintPage
PrintDocument4.Print()
End If
End If
End Sub

Related

VB.NET resize and crop images

i have a VSTO for powerpoint and want to resize images so they are the same size as the slide. a sample image i have is 1000x300 and the slide is 960x540. so this is the code i have:
_W=960
_H=540
Dim img As Image = System.Drawing.Bitmap.FromFile(file1)
OldRect = New RectangleF(233, 0, 533, 300) ' calculated values to crop left and right
NewRect = New RectangleF(0, 0, _W, _H)
Dim bmp As Bitmap = New Bitmap(img, _W, _H)
Dim g As Graphics = Graphics.FromImage(bmp)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
g.DrawImage(img, NewRect, OldRect, GraphicsUnit.Pixel)
img.Save(file2, Imaging.ImageFormat.Png)
but when i look at file2 it's the same 1000x300 file as the original. what am i missing here?
#plutonix; you're spot on. i was under the wrong impression that DrawImage would replace the image it was offered. but saving the bitmap the graphics object was created with produced the intended image.
bmp.Save(file2, Imaging.ImageFormat.Png)
works perfect. thanks!
The answer posted here is good but there is one major problem of quality that need to be addressed. In most cased you have to Crop Image and Maintain the Quality so in that regard, I have improved the crop feature of a sample and posted below is the link. This demo is in VB.NET but you can easily understand the concept and make adjustments.
http://www.mediafire.com/file/70rmlpcdjyxo8gc/ImageCroppingDemo_-_Maintain_Image_Quality.zip/file
CODES For Cropping (VB.NET)
Dim cropX As Integer
Dim cropY As Integer
Dim cropWidth As Integer
Dim cropHeight As Integer
Dim oCropX As Integer
Dim oCropY As Integer
Dim cropBitmap As Bitmap
Dim Loadedimage As Image
Public cropPen As Pen
Public cropPenSize As Integer = 1 '2
Public cropDashStyle As Drawing2D.DashStyle = Drawing2D.DashStyle.Solid
Public cropPenColor As Color = Color.Yellow
Private Sub crobPictureBox_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles crobPictureBox.MouseDown
Try
If e.Button = Windows.Forms.MouseButtons.Left Then
cropX = e.X
cropY = e.Y
cropPen = New Pen(cropPenColor, cropPenSize)
cropPen.DashStyle = DashStyle.DashDotDot
Cursor = Cursors.Cross
End If
crobPictureBox.Refresh()
Catch exc As Exception
End Try
End Sub
Dim tmppoint As Point
Private Sub crobPictureBox_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles crobPictureBox.MouseMove
Try
If crobPictureBox.Image Is Nothing Then Exit Sub
If e.Button = Windows.Forms.MouseButtons.Left Then
crobPictureBox.Refresh()
cropWidth = e.X - cropX
cropHeight = e.Y - cropY
crobPictureBox.CreateGraphics.DrawRectangle(cropPen, cropX, cropY, cropWidth, cropHeight)
End If
' GC.Collect()
Catch exc As Exception
If Err.Number = 5 Then Exit Sub
End Try
End Sub
Private Sub crobPictureBox_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles crobPictureBox.MouseUp
Try
Cursor = Cursors.Default
Try
If cropWidth < 1 Then
Exit Sub
End If
Dim smallWidthPercentage As Single = (cropWidth / crobPictureBox.Width) * 100
Dim smallHeightPercentage As Single = (cropHeight / crobPictureBox.Height) * 100
Dim smallXPercentage As Single = (cropX / crobPictureBox.Width) * 100
Dim smallYPercentage As Single = (cropY / crobPictureBox.Height) * 100
smallHeightPercentage += 10
smallYPercentage -= 10
Dim Widthdifference As Integer = Loadedimage.Width - crobPictureBox.Width
Dim HeightDifference As Integer = Loadedimage.Height - crobPictureBox.Height
Dim rect As Rectangle
rect = New Rectangle((smallXPercentage / 100) * Loadedimage.Width, (smallYPercentage / 100) * Loadedimage.Height, (smallWidthPercentage / 100) * Loadedimage.Width, (smallHeightPercentage / 100) * Loadedimage.Height)
Dim bit As Bitmap = New Bitmap(Loadedimage, Loadedimage.Width, Loadedimage.Height)
cropBitmap = New Bitmap(Loadedimage, (smallWidthPercentage / 100) * Loadedimage.Width, (smallHeightPercentage / 100) * Loadedimage.Height)
Dim g As Graphics = Graphics.FromImage(cropBitmap)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
g.DrawImage(bit, 0, 0, rect, GraphicsUnit.Pixel)
PreviewPictureBox.Image = cropBitmap
Catch exc As Exception
End Try
Catch exc As Exception
End Try
End Sub

Print a Cheque with PrintDocument in VB.NET

I am using following code in VB.NET 4.0 to print a cheque.
In printpreview dialog, print is shown correctly but when printed actually,
print starts from bottom of cheque.
I want print to start from start point of cheque.
Cheque is inserted in middle of printer tray vertically.
Private print_document As PrintDocument
Private FIRST_TO_PRINT As String = "CHEQUE"
Private fontsize As Integer = 12
Private _ID As Integer = 0
Private CHEQUE_DATE As Date
Private CLIENT_NAME As String
Private CLIENT_NAME_ON_CHEQUE As String
Private AMOUNT As Decimal
Private AMOUNT_IN_WORDS As String
Public Sub New(ID As Integer)
_ID = ID
End Sub
Public Function PreparePrintDocument() As PrintDocument
' Make the PrintDocument object.
print_document = New PrintDocument
print_document.DefaultPageSettings.PaperSize = New PaperSize("Custom", 336, 768)
'print_document.OriginAtMargins = True
'print_document.DefaultPageSettings.Margins.Left = 200
'print_document.DefaultPageSettings.Margins.Right = 10
'print_document.DefaultPageSettings.Margins.Bottom = 10
'print_document.DefaultPageSettings.Margins.Top = 200
AddHandler print_document.BeginPrint, AddressOf Print_BeginPrint
' Install the PrintPage event handler.
AddHandler print_document.PrintPage, AddressOf Print_PrintPage
' Return the object.
Return print_document
End Function
Protected Sub Print_BeginPrint(sender As Object, e As PrintEventArgs)
GetVoucherDetails()
End Sub
Private Sub GetVoucherDetails()
Dim objVOUCHER_BLL As VOUCHER_BLL
Try
objVOUCHER_BLL = New VOUCHER_BLL
Dim temps As VOUCHERDataTable = objVOUCHER_BLL.GetVoucherByID(_ID)
If temps.Count > 0 Then
Dim temp As VOUCHERRow = temps(0)
CHEQUE_DATE = temp.CHEQUE_DATE
CLIENT_NAME = temp.CLIENT_NAME
CLIENT_NAME_ON_CHEQUE = temp.CLIENT_NAME_ON_CHEQUE
AMOUNT = temp.AMOUNT
AMOUNT_IN_WORDS = numToWords.AmtInWord(temp.AMOUNT)
End If
Catch ex As Exception
Finally
objVOUCHER_BLL = Nothing
End Try
End Sub
' Print the next page.
Private Sub Print_PrintPage(ByVal sender As Object, ByVal e _
As System.Drawing.Printing.PrintPageEventArgs)
Dim our_brush As Brush = Brushes.Black
Dim font As New Font("Verdana", fontsize)
If FIRST_TO_PRINT = "CHEQUE" Then
e.PageSettings.PaperSize = New PaperSize("Custom", 336, 768)
e.Graphics.ResetTransform()
e.Graphics.TranslateTransform(306, 580)
e.Graphics.RotateTransform(90)
e.Graphics.DrawString(CHEQUE_DATE.ToString("dd MM yyyy"), font, our_brush, New Point(0, 0))
e.Graphics.ResetTransform()
e.Graphics.TranslateTransform(262, 20)
e.Graphics.RotateTransform(90)
e.Graphics.DrawString(CLIENT_NAME_ON_CHEQUE, font, our_brush, New Point(70, 0))
e.Graphics.ResetTransform()
e.Graphics.TranslateTransform(232, 140)
e.Graphics.RotateTransform(90)
e.Graphics.DrawString(AMOUNT_IN_WORDS.Replace("Rupees ", String.Empty).ToUpper, font, our_brush, New Point(0, 0))
e.Graphics.ResetTransform()
e.Graphics.TranslateTransform(206, 600)
e.Graphics.RotateTransform(90)
e.Graphics.DrawString(AMOUNT.ToString("F2") & " /-", font, our_brush, New Point(0, 0))
' e.HasMorePages = True
' e.Graphics.ResetTransform()
' FIRST_TO_PRINT = "VOUCHER"
'Else
' e.PageSettings.PaperSize = New PaperSize("Custom", 612, 792)
' e.Graphics.DrawString("VOUCHER", font, our_brush, New Point(200, 200))
' FIRST_TO_PRINT = "CHEQUE"
e.Graphics.ResetTransform()
e.HasMorePages = False
End If
End Sub

How to change image in picture box when clicked

I have used the following code in a program that I am designing to book seats. Each picturebox is a seat, and when each picturebox is clicked, the image should change from Seating_No_Person to Seating_With_Person to show that the seat has been selected. I am currently getting a problem with the changing image, as when clicked, none of the pictureboxes swap images. Anyone got any suggestions?
Thanks
Public Class Form1
Public Class Seating
Public SeatRow As Integer = 0
Public SeatColumn As Integer = 0
Public PB As PictureBox = Nothing
Public Occupied As Boolean = False
End Class
Private seatingList As New List(Of Seating)
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim xPosition As Integer = -50
Dim yPosition As Integer = -25
For i As Integer = 1 To 5
'Number of rows
For j As Integer = 1 To 10
Dim pb As New PictureBox
With pb
.Name = "PictureBox" & i.ToString & j.ToString
'Name of Picture box i.e. if i = 1 (row 1), j = 3 (column 3), name is PictureBox13
.SizeMode = PictureBoxSizeMode.Zoom
.Size = New Size(60, 60)
'Size of seat is 60 by 60
.Location = New Point(xPosition + (j * 70), yPosition + (i * 70))
'Location of picture box is: -50 + (columnnumber * 70), -25 + (rownumber * 70)
.Image = My.Resources.Seating_No_Person
Me.Controls.Add(pb)
AddHandler pb.Click, AddressOf PictureBox_Click
Dim thisSeating As New Seating
With thisSeating
.SeatRow = i
.SeatColumn = j
.PB = pb
.Occupied = True
End With
seatingList.Add(thisSeating)
End With
Next
Next
End Sub
Private Sub PictureBox_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim pb As PictureBox = DirectCast(sender, PictureBox)
Dim seatRowNum As Integer = CInt(pb.Name.Replace("PictureBox", ""))
Dim seatColumnNum As Integer = CInt(pb.Name.Replace("PictureBox", ""))
Dim qry = From seat As Seating In seatingList Where seat.SeatRow = seatRowNum And seat.SeatColumn = SeatColumnNum
If qry.Count = 1 Then
If qry.First.Occupied = True Then
pb.Image = My.Resources.Seating_No_Person
qry.First.Occupied = False
Else
pb.Image = My.Resources.Seating_With_Person
qry.First.Occupied = True
End If
End If
End Sub
End Class
I would suggest setting a breakpoint and debugging to see where you're going wrong. If you just call DirectCast(sender, PictureBox).Image = My.Resources.Seating_With_Person inside Private Sub PictureBox_Click it works, which suggests that there is problem with the logic inside your If block.

Printing multiple pages from an ArrayList

First let me start off with I am not a vb.net developer. In fact I have never been trained in the art of VB. That being said I am working on a very simple application that takes a csv file and parses a single column to an array list. Now i need to take that array list and print a individual page (Without preview) of each item on the array list. So each item on the array list will have its own page.
Heres what i have so far. Im sure Im way off seeing as I cant figure out how to turn this into multi-pages.
Private Sub Print()
Dim PrintPreviewSelected As Boolean = False
'Set the doc to print
Dim pDoc As New PrintDocument
pDoc.PrintController = New StandardPrintController 'turns off the printing page x of y dialog
Try
Using sr As New StreamReader(file)
defPrinter = sr.ReadToEnd()
End Using
Catch e As Exception
End Try
If defPrinter = "" Then
If Me.PrintDialog1.ShowDialog() = DialogResult.OK Then
pDoc.PrinterSettings.PrinterName = Me.PrintDialog1.PrinterSettings.PrinterName
End If
Else
pDoc.PrinterSettings.PrinterName = defPrinter
End If
pDoc.DefaultPageSettings.Landscape = True
pDoc.DefaultPageSettings.Margins = New Margins(40, 10, 10, 10)
pDoc.OriginAtMargins = True
AddHandler pDoc.PrintPage, AddressOf PrintSett
If PrintPreviewSelected Then
PrintPreviewDialog1.Document = pDoc
PrintPreviewDialog1.UseAntiAlias = True
PrintPreviewDialog1.WindowState = FormWindowState.Maximized
PrintPreviewDialog1.ShowDialog()
Else
If txtFile.Text <> "" Then
pDoc.Print()
Else
MessageBox.Show("You must select a file first", "Select a file.")
End If
End If
RemoveHandler pDoc.PrintPage, AddressOf PrintSett
End Sub
Private Sub PrintSett(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
Dim fnt10 As Font = New Font("Courier New", 34, FontStyle.Regular)
e.Graphics.DrawString("", fnt10, Brushes.Black, 318, 412)
End Sub
Any help would be appreciated! I know i havent laid any of the foundation for you guys to work off of but frankly Im strait up lost. Thanks guys!
Following matzone's suggestion I was able to figure it out.
Dim PageNumber As Integer = 1
Dim morePage As String
Private Sub PrintSett(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
Dim ReportFont As New Font("Arial", 45, FontStyle.Regular)
Dim VerticalPrintLocationSingle As Single = 412
Dim HorizontalPrintLocationSingle As Single = e.MarginBounds.Left
Dim TextString As String
Dim sngCenterPage As Single
If customerList.Count > (PageNumber) Then
If customerList.Item(PageNumber) IsNot "" Then
TextString = customerList.Item(PageNumber)
Console.WriteLine(customerList.Item(PageNumber))
sngCenterPage = Convert.ToSingle(e.PageBounds.Width / 2 - e.Graphics.MeasureString(customerList.Item(PageNumber), ReportFont).Width / 2)
PageNumber += 1
morePage = True
End If
Else
morePage = False
customerList.Clear()
End If
e.Graphics.DrawString(TextString, ReportFont, Brushes.Black, sngCenterPage, VerticalPrintLocationSingle)
e.HasMorePages = morePage
End Sub
Thanks again!

Copy files with progress

I am wanting the most efficient way to copy a file with a progress bar updating the copy percentage.
This is the standard copy code I am using:
System.IO.File.Copy(source,target)
This is very fast and efficient. However, I cannot report the copy percentage.
I have tried many functions that read and save a file by opening up the filestream and then looping while reading/writing the data. This enables me to report the progress.
Here are the functions that I am using:
Public Sub SaveBinaryFile(strFilename As String, bytesToWrite() As Byte)
Dim position As Integer = 0
Dim BufferSize As Integer = 4096
'frmMain.tsProgressBar.Value = 0
Using fsNew As FileStream = New FileStream(strFilename, FileMode.Create, FileAccess.Write)
Do
Dim intToCopy As Integer = Math.Min(BufferSize, bytesToWrite.Length - position)
Dim buffer(intToCopy - 1) As Byte
Array.Copy(bytesToWrite, position, buffer, 0, intToCopy)
fsNew.Write(buffer, 0, buffer.Length)
'frmMain.tsProgressBar.Value = ((position / bytesToWrite.Length) * 100)
'frmMain.tsProgressBar.Refresh()
Application.DoEvents()
position += intToCopy
Loop While position < bytesToWrite.Length
End Using
End Sub
Public Function ReadBinaryFile(strFilename As String) As Byte()
Dim position As Integer = 0
Dim bufferSize As Integer = 4096
Dim bytes() As Byte
'frmMain.tsProgressBar.Value = 0
Using fsOpen As FileStream = New FileStream(strFilename, FileMode.Open)
ReDim bytes((fsOpen.Length) - 1)
Do
If (position + bufferSize) > fsOpen.Length Then
fsOpen.Read(bytes, position, fsOpen.Length - position)
Exit Do
Else
fsOpen.Read(bytes, position, bufferSize)
End If
'frmMain.tsProgressBar.Value = ((position / fsOpen.Length) * 100)
'frmMain.tsProgressBar.Refresh()
Application.DoEvents()
position += bufferSize
Loop
End Using
Return bytes
End Function
The problem is that is a lot slower than using the straight copy code.
What is the best/efficient way to copy a file showing the copy progress?
thanks
There is a variant of System.IO.File that provides user feedback; it's called Microsoft.VisualBasic.FileIO.FileSystem. See also http://msdn.microsoft.com/en-us/library/cc165446.aspx.
hmm Try this function
Dim D As Integer
Function CopyFileWithProgress(ByVal Source As String, ByVal Destination As String) As Integer
Try
Dim SourceF As New IO.FileStream(TextBox1.Text, IO.FileMode.Open)
Dim DestinationF As New IO.FileStream(TextBox2.Text & "\" & TextBox3.Text & ".ps4game", IO.FileMode.Create)
Dim len As Long = SourceF.Length - 1
Dim buffer(1024) As Byte
Dim byteCFead As Integer
While SourceF.Position < len
byteCFead = (SourceF.Read(buffer, 0, 1024))
DestinationF.Write(buffer, 0, byteCFead)
D = CInt(SourceF.Position / len * 100)
Application.DoEvents()
End While
DestinationF.Flush()
DestinationF.Close()
SourceF.Close()
Return D
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Function
it will work
you can use:
Microsoft.VisualBasic.FileIO.FileSystem.CopyFile("C:\[Copy From]", "C:\[Copy To]", _
FileIO.UIOption.AllDialogs)
' this requires the Microsoft.VisualBasic.dll, which is referenced from Visual Basic .NET
' projects by default, but needs to be added to C# projects manually
OR :
Dim CF As New IO.FileStream("C:\[Copy From]", IO.FileMode.Open)
Dim CT As New IO.FileStream("C:\[Copy To]", IO.FileMode.Create)
Dim len As Long = CF.Length - 1
Dim buffer(1024) As Byte
Dim byteCFead As Integer
While CF.Position < len
byteCFead = (CF.Read(buffer, 0, 1024))
CT.Write(buffer, 0, byteCFead)
ProgressBar1.Value = CInt(CF.Position / len * 100)
Application.DoEvents()
End While
CT.Flush()
CT.Close()
CF.Close()
OR : Using WebClient
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If Not OpenFileDialog1.ShowDialog() = DialogResult.OK Then Return
If Not FolderBrowserDialog1.ShowDialog = DialogResult.OK Then Return
Button1.Enabled = False
WebClient1.DownloadFileAsync(New Uri(OpenFileDialog1.FileName), Path.Combine(FolderBrowserDialog1.SelectedPath, OpenFileDialog1.SafeFileName))
End Sub
Private Sub WebClient1_DownloadProgressChanged(sender As Object, e As DownloadProgressChangedEventArgs) Handles WebClient1.DownloadProgressChanged
ProgressBar1.Value = e.ProgressPercentage
End Sub
Private Sub WebClient1_DownloadFileCompleted(sender As Object, e As System.ComponentModel.AsyncCompletedEventArgs) Handles WebClient1.DownloadFileCompleted
Button1.Enabled = True
End Sub