I'm Using Visual studio 10.i want to convert colored image into a black and white?
i have tried to do following code it gets success but it takes lots of time to convert. can i do convert it without using anyloop in vb.net.
Thanks In Advance
Try
Dim img As Bitmap = New Bitmap((Image.FromFile("D:\\imgnam.jpg")))
Dim c As Color
Dim i As Integer = 0
Do While (i < img.Width)
Dim j As Integer = 0
Do While (j < img.Height)
c = img.GetPixel(i, j)
Dim r As Integer = 0
r = Convert.ToInt16(c.R)
Dim g As Integer = 0
g = Convert.ToInt16(c.G)
Dim b As Integer = 0
b = Convert.ToInt16(c.B)
Dim ans As Integer = ((r _
+ (g + b)) _
/ 3)
If (ans > 128) Then
r = 255
g = 255
b = 255
Else
r = 0
g = 0
b = 0
End If
c = Color.FromArgb(r, g, b)
img.SetPixel(i, j, c)
j = (j + 1)
Loop
i = (i + 1)
Loop
img.Save("D:\\imgnamNew.jpg")
Dim Bmp1 As New Image(Of Bgr, [Byte])("D:\\imgnamNew.jpg")
ImageFrame = Bmp1
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
Related
Here's the code I am not sure if there's any hidden error but on runtime when trying to import the rsa parameters it pops up that error
Imports System.Security.Cryptography
Imports System.Security
Imports System.Text
Imports System.IO
Public Class RSA_Test_Form
Public FactorList As New List(Of Integer)
Public FindFactor As Long
Public PString, QString, ModulusString, ExponentString, DString, DPString,
DQString, InverseQString As String
Function ModInverse(ByVal a As Long, ByVal b As Long) As Long
Dim b0 As Long = b
Dim t As Long
Dim q As Long
Dim x0 As Long = 0
Dim x1 As Long = 1
If b = 1 Then Return 1
While a > 1
q = a \ b
t = b
b = a Mod b
a = t
t = x0
x0 = x1 - q * x0
x1 = t
End While
If x1 < 0 Then x1 += b0
Return x1
End Function
Function gcd(ByVal n1 As Long, ByVal n2 As Long) As Long
Dim i As Integer
Dim minimum As Integer
If n1 < n2 Then
minimum = n1
Else
minimum = n2
End If
For i = minimum To 1 Step -1
If n1 Mod i = 0 And n2 Mod i = 0 Then
Return i
End If
Next
Return gcd
End Function
Sub FindFactorFunction()
Dim x As Long
For x = 2 To FindFactor - 1
If FindFactor Mod x = 0 Then
FactorList.Add(x)
End If
Next
End Sub
Private Sub GenerateBTN_Click(sender As Object, e As EventArgs) Handles GenerateBTN.Click
Dim Result As Long = 0
Dim Result2 As Long = 0
Dim Result3 As Long = 0
Dim Random1, Random2 As New Random()
Dim P, Q, Modulus As Long
Dim Exponent, D, DP, DQ As New Nullable(Of Long)
Dim InverseQ As New Nullable(Of ULong)
Dim Modulus1 As Long = 0
Dim LoopCount As Integer = 0
Dim ls, ls2 As New List(Of Long)
Dim PrimeString As String
PrimeString = ""
Using MyNewStreamReader As StreamReader = New StreamReader("AllPrimes.txt")
PrimeString = MyNewStreamReader.ReadLine().ToString
MessageBox.Show(PrimeString)
While PrimeString <> "" And LoopCount <= 1249
ls.Add(Long.Parse(PrimeString))
LoopCount += 1
PrimeString = ""
PrimeString = MyNewStreamReader.ReadLine
End While
End Using
Using MyNewStreamReader2 As StreamReader = New StreamReader("AllPrimes.txt")
PrimeString = ""
PrimeString = MyNewStreamReader2.ReadLine().ToString
LoopCount = 0
MessageBox.Show(PrimeString)
While PrimeString <> ""
If LoopCount >= 1250 And LoopCount <= 2499 Then
ls2.Add(Long.Parse(PrimeString))
End If
LoopCount += 1
PrimeString = ""
PrimeString = MyNewStreamReader2.ReadLine
End While
End Using
Dim rand = Random1.Next(0, ls.Count)
Dim rand2 = Random2.Next(0, ls2.Count)
P = ls(rand)
Q = ls2(rand2)
Result3 = gcd(P, Q)
While Result3 <> 1
rand = Random1.Next(0, ls.Count)
rand2 = Random2.Next(0, ls2.Count)
P = ls(rand)
Q = ls2(rand2)
Result3 = gcd(P, Q)
End While
MessageBox.Show("P= " & P & "Q= " & Q)
Modulus = (P - 1) * (Q - 1)
Modulus1 = Modulus + 1
FindFactor = Modulus1
FindFactorFunction()
Dim Count As Integer = 0
Dim Count2 As Integer = 0
For A As Integer = 0 To FactorList.Count - 1
Result = gcd(FactorList.ElementAt(A), Modulus)
If Result = 1 Then
Count += 1
End If
Next
Dim PositionArray(Count) As Integer
Count = 0
For A As Integer = 0 To FactorList.Count - 1
Result = gcd(FactorList.ElementAt(A), Modulus)
If Result = 1 Then
PositionArray(Count) = FactorList.ElementAt(A)
Count += 1
End If
Next
Dim Number1, Number2 As Long
Dim GetResult As Boolean = False
Count = 0
If PositionArray.Count = 2 Then
Exponent = PositionArray(0)
D = PositionArray(1)
Else
While GetResult = False And Count <> PositionArray.Count
For Count = 0 To PositionArray.Count - 1
For Count2 = Count + 1 To PositionArray.Count - 1
Number1 = PositionArray(Count)
Number2 = PositionArray(Count2)
Result2 = Number1 * Number2 Mod Modulus
If Result2 = 1 Then
GetResult = True
End If
If GetResult = True Then
Exit While
End If
Next
Next
End While
End If
Dim Selection As Integer = MessageBox.Show(Number1 & "=E And D= " & Number2, "Information", MessageBoxButtons.OKCancel, MessageBoxIcon.Information)
If Selection = DialogResult.OK Then
Exponent = Number1
D = Number2
DP = D * P
DQ = D * Q
InverseQ = ModInverse(Q, P)
MessageBox.Show("DP= " & DP)
MessageBox.Show("DQ= " & DQ)
MessageBox.Show("InverseQ= " & InverseQ)
In here when generating RSA numbers, I can not always get the correct numbers so i am using this website to check that i have get the correct RSA numbers and the D and Exponent was not = 0
Exponent=e
Everytime I get Exponent and D, I will always use this website to check P,Q,Exponent and D to make sure it's correct
https://www.cs.drexel.edu/~jpopyack/IntroCS/HW/RSAWorksheet.html
End If
If Exponent.HasValue And D.HasValue Then
PString = P.ToString
QString = Q.ToString
ModulusString = Modulus.ToString
ExponentString = Exponent.ToString
DString = D.ToString
DPString = DP.ToString
DQString = DQ.ToString
InverseQString = InverseQ.ToString
In here all D,P,Q,DP,DQ,Exponent,Modulus,InverseQ value has been calculated and checked
End If
End Sub
Private Sub Number2ByteConverterBTN_Click(sender As Object, e As EventArgs) Handles Number2ByteConverterBTN.Click
If it's possible try check the coding here, perhaps this place was the place that i do it wrongly
I initially thought of using BitCoverter.GetBytes() to convert the long and Ulong datatype value
But in the end, the bitconverter.getbytes() doesn't work for me so i have to first convert all those long and ulong data type values into string then use BYTE.PARSE() to convert the string into byte value
That's how i do it
If let's any experts here confirmed that the coding above worked and all the values are correct then try to check is there any potential error here
Dim PByte, QByte, ModulusByte, ExponentByte, DByte, DPByte, DQByte, InverseQByte As Byte()
ReDim PByte(PString.Count)
ReDim QByte(QString.Count)
ReDim ModulusByte(ModulusString.Count)
ReDim ExponentByte(ExponentString.Count)
ReDim DByte(DString.Count)
ReDim DPByte(DPString.Count)
ReDim DQByte(DQString.Count)
ReDim InverseQByte(InverseQString.Count)
Dim TempPByte, TempQByte, TempModulusByte, TempExponentByte, TempDByte As New Byte
Dim StringBuilder As New StringBuilder
Dim StringBuilder2 As New StringBuilder
Dim StringBuilder3 As New StringBuilder
Dim StringBuilder4 As New StringBuilder
Dim StringBuilder5 As New StringBuilder
Dim StringBuilder6 As New StringBuilder
Dim StringBuilder7 As New StringBuilder
Dim StringBuilder8 As New StringBuilder
For i As Integer = 0 To PString.Length - 1
PByte(i) = Byte.Parse(PString.ElementAt(i))
StringBuilder.Append(PByte(i).ToString)
Next
For i As Integer = 0 To QString.Length - 1
QByte(i) = Byte.Parse(QString.ElementAt(i))
StringBuilder2.Append(QByte(i).ToString)
Next
For i As Integer = 0 To ModulusString.Length - 1
ModulusByte(i) = Byte.Parse(ModulusString.ElementAt(i))
StringBuilder3.Append(ModulusByte(i).ToString)
Next
For i As Integer = 0 To ExponentString.Length - 1
ExponentByte(i) = Byte.Parse(ExponentString.ElementAt(i))
StringBuilder4.Append(ExponentByte(i).ToString)
Next
For i As Integer = 0 To DString.Length - 1
DByte(i) = Byte.Parse(DString.ElementAt(i))
StringBuilder5.Append(DByte(i).ToString)
Next
For i As Integer = 0 To DPString.Length - 1
DPByte(i) = Byte.Parse(DPString.ElementAt(i))
StringBuilder6.Append(DPByte(i).ToString)
Next
For i As Integer = 0 To DQString.Length - 1
DQByte(i) = Byte.Parse(DQString.ElementAt(i))
StringBuilder7.Append(DQByte(i).ToString)
Next
For i As Integer = 0 To InverseQString.Length - 1
InverseQByte(i) = Byte.Parse(InverseQString.ElementAt(i))
StringBuilder8.Append(InverseQByte(i).ToString)
Next
Dim MyRSAParams As New RSAParameters
MyRSAParams.P = PByte
MyRSAParams.Q = QByte
MyRSAParams.Exponent = ExponentByte
MyRSAParams.Modulus = ModulusByte
MyRSAParams.D = DByte
MyRSAParams.DP = DPByte
MyRSAParams.DQ = DQByte
MyRSAParams.InverseQ = InverseQByte
Dim MyRSA As RSA
MyRSA = RSA.Create()
MyRSA.ImportParameters(MyRSAParams)
End Sub
Private Sub RSA_Test_Form_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim temp, temp2 As Integer
temp = gcd(1, 2)
temp2 = gcd(2, 3)
FindFactor = 0
End Sub
End Class
What I am trying to do in the generate button was to create the suitable parameters for RSA.
The parameters I was actually able to generate them but in either ULong or Long data type.
When i first convert them into array of Bytes I have considered to use BitConverter but it doesn't work at least in my case.
The only way i am only able to make them into array of Bytes was by making the ULong or Long data type variable into string.
Then convert those string into Byte then put them into ByteArray
I hope it was correct but it is out of my reach for now.
Any ideas on how can i make the parameter data to be accepted as rsa parameter?
I want to change the red pixels to blue. The image is 24 bits .bmp. I am using lockbits because it is faster but the code doesnt find the red pixels!
Code:
Dim bmp As Bitmap = New Bitmap("path")
Dim pos As Integer
Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits _
(rect, Drawing.Imaging.ImageLockMode.ReadWrite,
bmp.PixelFormat)
Dim ptr As IntPtr = bmpData.Scan0
Dim bytes As Integer = Math.Abs(bmpData.Stride) * bmp.Height
Dim rgbValues(bytes - 1) As Byte
Marshal.Copy(ptr, rgbValues, 0, bytes)
For y = 0 To bmp.Height - 1
For x = 0 To bmp.Width - 1
pos = y * bmp.Width * 3 + x * 3
If rgbValues(pos) = 255 And rgbValues(pos + 1) = 0 And rgbValues(pos + 2) = 0 Then
rgbValues(pos + 2) = 255
rgbValues(pos) = 0
End If
Next
Next
Marshal.Copy(rgbValues, 0, ptr, bytes)
bmp.UnlockBits(bmpData)
bmp.Save("new path")
Thank you!
The values that are stored in rgbValues are not in this order
R G B R G B.....
but
B G R B G R.....
so the correct code in your loop is:
' B G R
If rgbValues(pos) = 0 And rgbValues(pos + 1) = 0 And rgbValues(pos + 2) = 255 Then
rgbValues(pos + 2) = 0 'R
rgbValues(pos) = 255 'B
End If
Im looking for a way to detect the center of grid squares when VB.net is feed an image
I want to start with an image of a grid with blue squares like this:
Grid
and i want the program to make an array of points in the center of each square like this (points aren't centered in picture)
Grid with Red points
i dont want to modify the image, i just want to get the points. I've tried getpixel for x and y but that just returns the same point
Dim search_color As Color = Color.FromArgb(255, 64, 128, 192)
Dim background_color As Color = Color.FromArgb(255, 240, 240, 240)
Dim grid_color As Color = Color.FromArgb(255, 144, 144, 144)
Dim pix As Color
Dim liney = 0, linex = 0
Dim loc, sloc, gloc As Point
For ch As Integer = 1 To 64
For y As Integer = liney To Bmp.Height - 1
For x As Integer = linex To Bmp.Width - 1
If Bmp.GetPixel(x, y) = search_color Then
sloc = New Point(x, y)
linex = x
liney = y
x = Bmp.Width - 1
y = Bmp.Height - 1
End If
Next
Next
Dim xloc = 0
For x As Integer = sloc.X To Bmp.Width - 1
If Bmp.GetPixel(x, sloc.Y) = grid_color Then
xloc = x - 1
End If
If Bmp.GetPixel(x, sloc.Y) = background_color Then
xloc = x - 1
End If
Next
For y As Integer = sloc.Y To Bmp.Height - 1
If Bmp.GetPixel(xloc, y) = grid_color Or Bmp.GetPixel(xloc, y) = background_color Then
gloc = New Point(xloc, y - 1)
End If
Next
loc = New Point((gloc.X + sloc.X) / 2, (gloc.Y + sloc.Y) / 2)
liney = gloc.Y
linex = gloc.X + 20
ListBox1.Items.Add(loc.ToString)
Next
Try this:
I added the following controls to a form to test the code:
pbImageToScan (PictureBox) - btnAnalyzeIMG (Button) - lbResult (ListBox)
Public Class Form1
Dim arrCenters() As Point
Dim bmpToAnalyze As Bitmap
Dim search_color As Color = Color.FromArgb(255, 64, 128, 192)
Dim background_color As Color = Color.FromArgb(255, 240, 240, 240)
Dim grid_color As Color = Color.FromArgb(255, 144, 144, 144)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
bmpToAnalyze = New Bitmap(Application.StartupPath & "\Image.bmp")
pbImageToScan.Image = Image.FromFile(Application.StartupPath & "\Image.bmp")
End Sub
Private Sub btnAnalyzeIMG_Click(sender As Object, e As EventArgs) Handles btnAnalyzeIMG.Click
FindCenters()
End Sub
Private Sub FindCenters()
bmpToAnalyze = New Bitmap(Application.StartupPath & "\Image.bmp")
pbImageToScan.Image = Image.FromFile(Application.StartupPath & "\Image.bmp")
'arrCenters is the array who will contains all centers data
ReDim arrCenters(0)
'arrCenters already starts with an element; this boolean is used to handle the first point insertion
Dim bFirstElementAddedToArray As Boolean
lbResult.Items.Clear()
Dim iIMGWidth As Integer = bmpToAnalyze.Width
Dim iIMGHeight As Integer = bmpToAnalyze.Height
'X, Y coordinates used for iterations
Dim iX As Integer = 0
Dim iY As Integer = 0
'Bitmap limits reached
Dim bExit As Boolean
'Used to skip a great part of Ys, if a match has been found along the current examinated line
Dim iDeltaYMax As Integer = 0
'Main cycle
Do While Not bExit
Dim colCurrentColor As Color = bmpToAnalyze.GetPixel(iX, iY)
If colCurrentColor = search_color Then
Dim iXStart As Integer = iX
Dim iYStart As Integer = iY
Dim iXEnd As Integer
Dim iYEnd As Integer
'Width of the Blue square
For iXEnd = iX + 1 To iIMGWidth - 1
Dim colColorSearchX As Color = bmpToAnalyze.GetPixel(iXEnd, iY)
If (colColorSearchX = background_color) Or (colColorSearchX = grid_color) Then
iXEnd -= 1
Exit For
End If
Next
'Height of the Blue square
For iYEnd = iY + 1 To iIMGHeight - 1
Dim colColorSearchY As Color = bmpToAnalyze.GetPixel(iXEnd, iYEnd)
If (colColorSearchY = background_color) Or (colColorSearchY = grid_color) Then
iYEnd -= 1
Exit For
End If
Next
iDeltaYMax = iYEnd - iYStart
'Blue square center coordinates
Dim pCenter As New Point((iXStart + iXEnd) / 2, (iYStart + iYEnd) / 2)
Dim iArrLenght As Integer = 0
If Not bFirstElementAddedToArray Then
bFirstElementAddedToArray = True
Else
iArrLenght = arrCenters.GetLength(0)
ReDim Preserve arrCenters(iArrLenght)
End If
arrCenters(iArrLenght) = pCenter
lbResult.Items.Add(pCenter.ToString)
iX = iXEnd
'Checks if the Width limit of the bitmap has been reached
If iX = (iIMGWidth - 1) Then
iX = 0
iY += iDeltaYMax + 1
iDeltaYMax = 0
Else
iX += 1
End If
Else
'Checks if the Width limit of the bitmap has been reached
If iX = (iIMGWidth - 1) Then
iX = 0
iY += iDeltaYMax + 1
iDeltaYMax = 0
Else
iX += 1
End If
End If
'Width and Height limit of the bitmap have been reached
If (iX = iIMGWidth - 1) And (iY = iIMGHeight - 1) Then
bExit = True
End If
Loop
'Draws a Red point on every center found
For Each P As Point In arrCenters
bmpToAnalyze.SetPixel(P.X, P.Y, Color.Red)
Next
pbImageToScan.Image = bmpToAnalyze
End Sub
End Class
I'll start off by saying i have jut started teaching myself VBA about a week ago, so I may not be asking the right question, but...
I am attempting to write a loop in Word VBA that will increment a number calculated partially from text retrieved from bookmarks. I want it to round up to the nearest .05, so .87 becomes .90 and .21 becomes .25.
The module that I have written follows:
A = ActiveDocument.Bookmarks("SRebateIncome").Range.Text
B = ActiveDocument.Bookmarks("RebateDefault").Range.Text
C = ((A - 6000) * 0.15)
D = B - C
E = B + D
F = (18200 + ((445 + E) / 0.19)) + 1
G = (0.19 * 18200) + 445 + E + (37000 * (0.015 + 0.325 - 0.19))
H = (G / (0.015 + 0.325)) + 1
I = ActiveDocument.Bookmarks("TRebateIncome").Range.Text
If F < 37000 = True Then
J = (0.125 * (I - F))
Else
J = (0.125 * (I - H))
End If
K = E - J
K = Format(Round(K, 2), "###,##0.00")
'round K up to the nearest .00 or .05
If K <> "###,###.#0" = False or K <> "###,###.#5") = False Then
Do
K = K + 0.01
Loop Until K = "###,###.#0" = True or K <> "###,###.#5") = True
End If
Set RebateOutput = ActiveDocument.Bookmarks("RebateOutput").Range
RebateOutput.Text = K
Now assuming that the value input for bookmarks "SRebateIncome", "RebateDefault" and "TRebateIncome" are 10175, 1602 and 43046 respectively, I expected the output to be 1460.80, but instead "K" is returned as 1460.78.
At this stage I don't know anything about using Excel within word (except copy/paste a spreadsheet into a document and I don't want to do that with this).
Any help would be appreciated
Thanks!
You can do it with an excel object and the Ceiling function
Option Explicit
Sub RoundText()
Dim dblSRebateIncome As Double
Dim dblRebateDefault As Double
Dim dblTRebateIncome As Double
Dim dblFinal As Double
Dim rngOutput As Range
Dim oExcel As Object
' Load the variables
Set oExcel = CreateObject("Excel.Application")
Set rngOutput = ActiveDocument.Bookmarks("RebateOutput").Range
dblSRebateIncome = CDbl(ActiveDocument.Bookmarks("SRebateIncome").Range.Text)
dblRebateDefault = CDbl(ActiveDocument.Bookmarks("RebateDefault").Range.Text)
dblSRebateIncome = CDbl(ActiveDocument.Bookmarks("TRebateIncome").Range.Text)
dblFinal = GetCalculatedValue(dblSRebateIncome, dblRebateDefault, dblTRebateIncome)
dblFinal = oExcel.worksheetfunction.Ceiling(dblFinal, 0.05)
rngOutput.Text = Format$(dblFinal, "###,##0.00")
End Sub
Function GetCalculatedValue(ByVal dblSIncome As Double, _
ByVal dblDefault As Double, _
ByVal dblTIncome) As Double
' Declare all the intermediate variables.
Dim c As Double, d As Double, e As Double
Dim f As Double, g As Double, h As Double
Dim j As Double, ret As Double
' Perform the complicated calculation
c = ((dblSIncome - 6000) * 0.15)
d = dblDefault - c
e = dblDefault + d
f = (18200 + ((445 + e) / 0.19)) + 1
g = (0.19 * 18200) + 445 + e + (37000 * (0.015 + 0.325 - 0.19))
h = (g / (0.015 + 0.325)) + 1
If f < 37000 Then
j = (0.125 * (dblTIncome - f))
Else
j = (0.125 * (dblTIncome - h))
End If
ret = e - j
' Return the value of the fucntion
GetCalculatedValue = ret
End Function
Hope this helps. :)
Dim x As Double
x = 1.111 'E.g.
Debug.Print Round(x * 20, 0)/20 '>> 1.10
I have found some code using google for listview printing. I modified the code base on my needs. I have some problem if the list view more than one pages. It will not stop counting "Generating Previews" of my document. If I press the cancel it was display the data in multiple pages but the same content.
Any suggestion would greatly appreciated.
Thanks in advance
Here is the code
Public Sub pd_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs)
Dim pd As New PrintDocument
Dim CurrRow As Integer = 0
Dim Ratio As Single = 0
Dim c As ColumnHeader
Dim g As Graphics = e.Graphics
Dim l As Integer = 0 'stores current left
Dim iCount As Integer
Dim f As Font = lsvToPrint.Font
Dim FontBold As New System.Drawing.Font("Microsoft Sans Serif", 10, FontStyle.Bold)
Dim b As Brush = Brushes.Black
Dim currentY As Integer = 0
Dim maxY As Integer = 0
Dim gap As Integer = 5
Dim lvsi As ListViewItem.ListViewSubItem
Dim colLefts(lsvToPrint.Columns.Count) As Integer
Dim colWidths(lsvToPrint.Columns.Count) As Integer
Dim idx As Integer = 0
Dim ii As Integer
Dim lr As RectangleF
e.HasMorePages = False
'Page Settings
Dim PSize As Integer = lsvToPrint.Items.Count
Dim PHi As Double
With pd.DefaultPageSettings
Dim Ps As PaperSize
PHi = PSize * 20 + 350
Ps = New PaperSize("Cust", 800, PHi)
.Margins.Top = 15
.Margins.Bottom = 20
.PaperSize = Ps
End With
Dim sfc As New StringFormat
sfc.LineAlignment = StringAlignment.Center
sfc.Alignment = StringAlignment.Center
'Title
Dim headfont As Font
Dim X1 As Integer
Dim Y As Integer
headfont = New Font("Courier New", 16, FontStyle.Bold)
X1 = pd.DefaultPageSettings.Margins.Left
Y = pd.DefaultPageSettings.Margins.Top + 5
With pd.DefaultPageSettings
e.Graphics.DrawLine(Pens.Black, 0, Y + 70, e.PageBounds.Width, Y + 70)
End With
'Headings
currentY = 100
For Each c In lsvToPrint.Columns
maxY = Math.Max(maxY, g.MeasureString(c.Text, f, c.Width).Height)
colLefts(idx) = l
colWidths(idx) = c.Width
lr = New RectangleF(colLefts(idx), currentY, colWidths(idx), maxY)
If lr.Width > 0 Then g.DrawString(c.Text, FontBold, b, lr, sfc)
l += c.Width
idx += 1
Next
currentY += maxY + gap
g.DrawLine(Pens.Black, 0, currentY, e.PageBounds.Width, currentY)
currentY += gap
'Rows
iCount = lsvToPrint.Items.Count - 1
For ii = CurrRow To iCount
If (currentY + maxY + maxY) > e.PageBounds.Height Then 'jump down another line to see if this line will fit
CurrRow = ii - 1
e.HasMorePages = True
currentY += maxY + gap
Exit For 'does next page
End If
l = 0
maxY = 0
idx = 0
For Each lvsi In lsvToPrint.Items(ii).SubItems
maxY = Math.Max(maxY, g.MeasureString(lvsi.Text, f, colWidths(idx)).Height)
lr = New RectangleF(colLefts(idx), currentY, colWidths(idx), maxY)
If lsvToPrint.Columns(idx).Text <> "Name" Then
If lr.Width > 0 Then g.DrawString(lvsi.Text , f, b, lr, sfc)
Else
If lr.Width > 0 Then g.DrawString(lvsi.Text, f, b, lr)
End If
idx += 1
Next
currentY += maxY + gap
Next
End Sub
Make sure that you compensate the height of the MaxY for the new page. On the first page it's fine, but then when it gets to the next page, CurrentY + MaxY might already be bigger than the height of the page.