I am working on a project where a button is clicked in a program and a two page duplex report that is in SSRS prints out. I have gotten it to the point where I get one of the two pages to print but not the duplex page. I know I need to set e.HasMorePages to true and put in an index. The problem is when it goes to page two it errors because of the metafile. I'm not sure how to get around this.
Imports System.IO
Imports System.Drawing.Imaging
Imports System.Drawing.Printing
Imports Microsoft.Reporting.WinForms
Public Class Printing
Dim pages As New List(Of Metafile)
Dim pageIndex As Integer = 0
Dim doc As New System.Drawing.Printing.PrintDocument()
Dim ReportViewer1 As New ReportViewer
Dim TotalQTY As Int32
Dim data() As Byte
Dim receiveText As String
Private Sub Printing_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'receiveText = Command()
receiveText = "08NFA-0000"
With ReportViewer1
.Visible = False
.ProcessingMode = ProcessingMode.Remote
.ServerReport.ReportPath = "/Traveler/Traveler"
.ServerReport.ReportServerUrl = New _
Uri("http://sql01/ReportServer_MADE2MANAGE")
End With
Me.Controls.Add(ReportViewer1)
Dim doc As New System.Drawing.Printing.PrintDocument()
doc = New System.Drawing.Printing.PrintDocument()
AddHandler doc.PrintPage, AddressOf PrintPageHandler
Dim dialog As New PrintDialog()
dialog.Document = doc
doc.PrinterSettings.Duplex = System.Drawing.Printing.Duplex.Vertical
Dim deviceInfo As String =
"<DeviceInfo>" &
"<OutputFormat>emf</OutputFormat>" &
" <PageWidth>8.5in</PageWidth>" &
" <PageHeight>11in</PageHeight>" &
" <MarginTop>0.125in</MarginTop>" &
" <MarginLeft>0.125in</MarginLeft>" &
" <MarginRight>0.125in</MarginRight>" &
" <MarginBottom>0.125in</MarginBottom>" &
"</DeviceInfo>"
Dim warnings() As Microsoft.Reporting.WinForms.Warning
Dim streamids() As String
Dim mimeType, encoding, filenameExtension As String
mimeType = "" : encoding = "" : filenameExtension = ""
Dim Parm As New ReportParameter("JobOrder", receiveText)
Dim parmSO1(0) As ReportParameter
parmSO1(0) = Parm
ReportViewer1.ServerReport.SetParameters(parmSO1)
data = ReportViewer1.ServerReport.Render("Image",
deviceInfo, mimeType, encoding, filenameExtension,
streamids, warnings)
pages.Add(New Metafile(New MemoryStream(data)))
For Each pageName As String In streamids
data = ReportViewer1.ServerReport.RenderStream("Image",
pageName, deviceInfo, mimeType, encoding)
pages.Add(New Metafile(New MemoryStream(data)))
Next
doc.Print()
Me.ReportViewer1.RefreshReport()
Me.Close()
End Sub
Private Sub PrintPageHandler(ByVal sender As Object,
ByVal e As PrintPageEventArgs)
Dim page As Metafile = pages(pageIndex)
pageIndex += 1
Dim pWidth As Integer = 910
Dim pHeight As Integer = 1500
e.Graphics.DrawImage(page, 0, 0, pWidth, pHeight)
e.HasMorePages = pageIndex < pages.Count
End Sub
End Class
Related
I'm trying to retrieve data from the web to desktop using vbnet, but whenever i tried to show it on datagridview it show this error.
It only succes when i only show the first column.
But when it comes to add more column it will show at first but have error like this.
And when i tried to run it again it have error like this.
The code i use :
Imports System.Net
Imports System.IO
Public Class Form1
Dim strArr() As String
Dim strArr1() As String
Dim count, c1 As Integer
Dim str, str2 As String
Private Sub DataGridView1_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) Handles DataGridView1.CellContentClick
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim k As Integer = 0
Dim uri As New Uri("http://localhost/tampil.php")
If (uri.Scheme = Uri.UriSchemeHttp) Then
Dim request As HttpWebRequest = HttpWebRequest.Create(uri)
request.Method = WebRequestMethods.Http.Get
Dim response As HttpWebResponse = request.GetResponse()
Dim reader As New StreamReader(response.GetResponseStream())
Dim pagehtml As String = reader.ReadToEnd()
response.Close()
str = pagehtml
strArr = str.Split(";")
For count = 0 To strArr.GetUpperBound(0)
ReDim Preserve strArr1(k)
strArr1(k) = strArr(count)
str2 = strArr1(k)
Dim words As String() = strArr1(k).Split(New Char() {"-"c})
If str2 = "" Then
Exit For
End If
DataGridView1.Rows.Add("")
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(0).Value = words(0)
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(1).Value = words(1)
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(2).Value = words(2)
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(3).Value = words(3)
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(4).Value = words(4)
k += 1
Next
End If
End Sub
End Class
Data from web
Can anyone help ?
Adding a row will return the index of the new row.
You can use that when updating the cell values.
This method will add the rows as you'd expect.
If there is any chance of values being returned from the html query that have a different number of elements, you should check that.
Private Sub LoadDataGridViewFromHTML(htmlValue As String)
Dim entities() As String = htmlValue.Split(Convert.ToChar(";"))
For Each entityItem As String In entities
If Not String.IsNullOrEmpty(entityItem) Then 'check you're not dealing with an empty string
Dim entityValues() As String = entityItem.Split(Convert.ToChar("-"))
Dim newRowId As Integer = DataGridView1.Rows.Add("")
DataGridView1.Rows(newRowId).Cells(0).Value = entityValues(0)
DataGridView1.Rows(newRowId).Cells(1).Value = entityValues(1)
DataGridView1.Rows(newRowId).Cells(2).Value = entityValues(2)
DataGridView1.Rows(newRowId).Cells(3).Value = entityValues(3)
DataGridView1.Rows(newRowId).Cells(4).Value = entityValues(4)
End If
Next
End Sub
been looking for a bit of code to take a screenshot and attach the screenshot to new email. I'll post what I have. It work 99%, just can't for the life of me figure out why it isn't attaching to the email.
It does everything but attach the new screenshot to the email. Is this possible?
Private Sub testStripMenuItem_Click(sender As Object, e As EventArgs) Handles testStripMenuItem.Click
Dim maxHeight As Integer = 0
Dim maxWidth As Integer = 0
For Each scr As Screen In Screen.AllScreens
maxWidth += scr.Bounds.Width
If scr.Bounds.Height > maxHeight Then maxHeight = scr.Bounds.Height
Next
Dim AllScreensCapture As New Bitmap(maxWidth, maxHeight, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim screenGrab As Bitmap
Dim screenSize As Size
Dim g As Graphics
Dim g2 As Graphics = Graphics.FromImage(AllScreensCapture)
Dim a As New Point(0, 0)
For Each scr As Screen In Screen.AllScreens
screenSize = New Size(scr.Bounds.Width, scr.Bounds.Height)
screenGrab = New Bitmap(scr.Bounds.Width, scr.Bounds.Height)
g = Graphics.FromImage(screenGrab)
g.CopyFromScreen(a, New Point(0, 0), screenSize)
g2.DrawImage(screenGrab, a)
a.X += scr.Bounds.Width
Next
Dim Screenshot = "C:\img.png"
If System.IO.File.Exists(Screenshot) Then
System.IO.File.Delete(Screenshot)
End If
AllScreensCapture.Save(Screenshot, System.Drawing.Imaging.ImageFormat.Jpeg)
'Email Code
Dim strUserDomain As String
Dim strCompName As String
strUserDomain = Environ$("UserDomain")
strCompName = Environ$("ComputerName")
Dim theStringBuilder As New StringBuilder()
theStringBuilder.Append("mailto:email#gmail.com.au")
theStringBuilder.Append("&subject=From Domain: " & strUserDomain & ". Computer Name: " & strCompName)
theStringBuilder.Append("&attach=" & Screenshot)
Process.Start(theStringBuilder.ToString())
End Sub
Alternative to sending through an installed mail client...
' Some of these may come from the form or user settings or wherever
Private Const MailSenderEmail As String = ""
Private Const MailSenderName As String = ""
Private Const MailRecipient As String = ""
Private Const MailSubject As String = ""
Private Const MailBody As String = ""
Private Const MailHost As String = ""
Private Const MailPort As String = ""
Private Const MailUser As String = ""
Private Const MailPass As String = ""
Private Const MailEnableSsl As Boolean = False
Private Sub testStripMenuItem_Click(sender As Object, e As EventArgs) Handles testStripMenuItem.Click
'
' Your code to capture the screen
'
Dim Screenshot = "C:\img.png"
If System.IO.File.Exists(Screenshot) Then
System.IO.File.Delete(Screenshot)
End If
AllScreensCapture.Save(Screenshot, System.Drawing.Imaging.ImageFormat.Jpeg)
' Send the email with Screenshot attached
Using MailMessage As New Net.Mail.MailMessage
With MailMessage
.From = New Net.Mail.MailAddress(MailSenderEmail, MailSenderName)
.To.Add(MailRecipient)
.Subject = MailSubject
.Body = MailBody
.Attachments.Add(New Net.Mail.Attachment(Screenshot))
End With
With New Net.Mail.SmtpClient
.Host = MailHost
.Port = MailPort
.EnableSsl = MailEnableSsl
Select Case True
Case String.IsNullOrWhiteSpace(MailUser)
Case String.IsNullOrWhiteSpace(MailPass)
Case Else
.Credentials = New Net.NetworkCredential(MailUser, MailPass)
End Select
.Send(MailMessage)
End With
End Using
End Sub
I have an app that basically is a launcher for various web pages. I am trying to, OnLoad, to populate all the pictureBoxes in my form with the FavICON for each URL. 25 to be exact. Should I use a For and Next or some other kind of looping method? New to the looping part so all and any help is appreciated.
My code to load just one single PictureBox is the following:
Private Sub MainFormWPL_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Dim WebICON As New WebBrowser
MainURLLoader.Navigate(Label1.Text)
'URLText.Text = WebBrowser1.Url.ToString
Try
Dim url As Uri = New Uri(Label1.Text)
If url.HostNameType = UriHostNameType.Dns Then
Dim icon = "http://" & url.Host & "/favicon.ico"
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(icon)
Dim response As System.Net.HttpWebResponse = request.GetResponse()
Dim stream As System.IO.Stream = response.GetResponseStream
Dim favicon = Image.FromStream(stream)
PictureBox1.Image = favicon
Else
End If
Catch ex As Exception
End Try
End Sub
Assuming you have Label1 --> PictureBox1, all the way to Label25 --> PictureBox25:
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim matches() As Control
For i As Integer = 1 To 25
matches = Me.Controls.Find("Label" & i, True)
If matches.Length > 0 Then
Dim website As String = matches(0).Text
matches = Me.Controls.Find("PictureBox" & i, True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is PictureBox Then
Dim PB As PictureBox = DirectCast(matches(0), PictureBox)
Task.Run(New Action(Sub() GetFavIcon(website, PB)))
End If
End If
Next
End Sub
Private Sub GetFavIcon(ByVal website As String, ByVal PB As PictureBox)
Dim url As Uri = New Uri(website)
If url.HostNameType = UriHostNameType.Dns Then
Dim icon = "http://" & url.Host & "/favicon.ico"
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(icon)
Dim response As System.Net.HttpWebResponse = request.GetResponse()
Dim stream As System.IO.Stream = response.GetResponseStream
Dim favicon = Image.FromStream(stream)
PB.Invoke(New MethodInvoker(Sub() PB.Image = favicon))
response.Close()
End If
End Sub
End Class
I'm programming a tool that'll go through a lot of websites and see if they contain a text that's in a textbox.
Now I wan't to add multi threading so it goes quite a lot faster, most preferably I'd dynamically add threads.
This is my code now but it didn't work because it says index ouf of range. And I doubt it work anyways.
Dim clsThreads As New Generic.List(Of System.Threading.Thread)
Dim numberOfthreads As Integer = 1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
For Each strLine1 As String In TextBox1.Text.Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
For Each strLine2 As String In TextBox2.Text.Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
clsThreads(numberOfthreads) = New Thread(Sub() Me.request(strLine1, strLine2))
clsThreads(numberOfthreads).Name = "Thread: " + numberOfthreads.ToString
clsThreads(numberOfthreads).IsBackground = True
clsThreads(numberOfthreads).Start()
numberOfthreads = numberOfthreads + 1
If (numberOfthreads.Equals(20)) Then
numberOfthreads = 0
End If
Next
Next
End Sub
So, how do I implement multi threading in a smart way?
This is my request sub:
Public Sub request(ByVal username, ByVal mail)
Dim req As WebRequest = WebRequest.Create("http://localhost/" + username)
req.Method = "GET"
Dim res As WebResponse = req.GetResponse()
Dim dataStream As Stream = res.GetResponseStream()
Dim reader As New StreamReader(dataStream)
Dim responseFromServer As String = reader.ReadToEnd()
If responseFromServer.Contains(mail) Then
TextBox3.Text = TextBox3.Text + vbNewLine + username
End If
End Sub
End Class
Something like this?
Option Strict On
Option Explicit On
Option Infer Off
Public Class Form1
Dim ActiveThreads As New List(Of System.Threading.Thread)
Delegate Sub delRemoveThread(thread As Threading.Thread)
Sub removeThread(thread As Threading.Thread)
If Me.InvokeRequired Then
Me.Invoke(New delRemoveThread(AddressOf removeThread), thread)
Else
ActiveThreads.Remove(thread)
End If
End Sub
Private Sub Button1_Click3(sender As Object, e As EventArgs) Handles Button1.Click
For i As Integer = 1 To 20
Dim th As New Threading.Thread(New Threading.ParameterizedThreadStart(Sub()
request("username", "mail")
removeThread(Threading.Thread.CurrentThread)
End Sub))
th.Start()
Next
End Sub
Public Sub request(ByVal username As String, ByVal mail As String)
Dim req As Net.WebRequest = Net.WebRequest.Create("http://localhost/" + username)
req.Method = "GET"
Dim res As Net.WebResponse = req.GetResponse()
Dim dataStream As IO.Stream = res.GetResponseStream()
Dim reader As New IO.StreamReader(dataStream)
Dim responseFromServer As String = reader.ReadToEnd()
If responseFromServer.Contains(mail) Then
TextBox3.Text = TextBox3.Text + vbNewLine + username
End If
End Sub
End Class
I have 2 projects, one which has a highscorelist stored on it, and one which tries to add highscores to that list and retrieve all items on the list. Trying to put items on the list works good, but retrieving the list doesn't work well. Here's the code:
Option Strict On
Option Explicit On
Imports System.Net.Sockets
Imports System.Threading
Public Class Main
Dim server As New TcpListener(45888)
Dim client As New TcpClient
Dim stream As NetworkStream
Dim connected As Boolean
Private Sub cmd_start_Click(sender As Object, e As EventArgs) Handles cmd_start.Click
server.Start()
cmd_start.Enabled = False
cmd_stop.Enabled = True
lbl_status.Text = "Running"
lbl_status.ForeColor = Color.Green
tmr.Start()
End Sub
Private Sub cmd_stop_Click(sender As Object, e As EventArgs) Handles cmd_stop.Click
server.Stop()
cmd_start.Enabled = True
cmd_stop.Enabled = False
lbl_status.Text = "Not running"
lbl_status.ForeColor = Color.Red
tmr.Stop()
End Sub
Private Sub Main_Load(sender As Object, e As EventArgs) Handles MyBase.Load
connected = False
CheckForIllegalCrossThreadCalls = False
End Sub
Dim x As Integer = 0
Private Sub tmr_Tick(sender As Object, e As EventArgs) Handles tmr.Tick
If server.Pending Then
client = server.AcceptTcpClient()
stream = client.GetStream()
tmr.Stop()
read()
Else
tmr.Start()
End If
lbl_mseconds.Text = "Relative time: " & x
x += 1
End Sub
Private Sub SendMessage(message As String)
Dim sendtext() As Byte = System.Text.Encoding.ASCII.GetBytes(message)
stream.Write(sendtext, 0, sendtext.Length)
stream.Flush()
End Sub
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = System.Text.Encoding.ASCII.GetString(rec)
If rectext.Contains("#1#") Then
rectext = rectext.Substring(3)
If rectext.Split(CChar("-"))(0).Length = 2 Then rectext = "0" & rectext
If rectext.Split(CChar("-"))(0).Length = 1 Then rectext = "00" & rectext
listbox_highscores.Items.Add(rectext)
ElseIf rectext.Contains("#2#") Then
Dim tosend As String = listbox_highscores.Items(0).ToString
For i = 1 To listbox_highscores.Items.Count - 1
tosend &= "," & listbox_highscores.Items(i).ToString
Next
MsgBox(tosend)
SendMessage(tosend)
End If
tmr.Start()
End Sub
End Class
On the other project I have this:
Dim server As New TcpListener(45888)
Dim client As New TcpClient
Dim stream As NetworkStream
Friend Sub sendHighscore(name As String, score As Integer)
Try
client.Connect("192.168.1.127", 45888)
Catch ex As Exception
Exit Sub
End Try
stream = client.GetStream()
Dim sendtext() As Byte = Encoding.ASCII.GetBytes("#1#" & score & "-" & name)
stream.Write(sendtext, 0, sendtext.Length)
client = New TcpClient
End Sub
Friend Sub getHighscoreList()
ListBox_highscores.Items.Clear()
Try
client.Connect("192.168.1.127", 45888)
Catch ex As Exception
ListBox_highscores.Items.Add("Couldn't connect")
Exit Sub
End Try
stream = client.GetStream()
Dim sendtext() As Byte = Encoding.ASCII.GetBytes("#2#")
stream.Write(sendtext, 0, sendtext.Length)
client = New TcpClient
read()
End Sub
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = Encoding.ASCII.GetString(rec)
Label2.Text = rectext
For Each item In rectext.Split(",")
ListBox_highscores.Items.Add(item)
Next
End Sub
Then when I use the sub sendHighscore() with a name and score, everything perfectly works and it shows in the other project on the list, but when I use the sub getHighscoreList() the list on the second project only contains the first item from the first list. Does someone has ideas?
Edit: Original answer removed entirely because it wasn't actually the problem (although it did offer improvements). My answer was nearly identical to this one anyway.
After analyzing this project much more closely, the problem with the For..Next loop not returning the expected results is because the strings are being sent back and forth as byte arrays in buffers much larger than necessary (client.ReceiveBufferSize). The actual "strings" received contain large amounts of non-printable characters (garbage) added to the end to fill the buffer. The quick and dirty solution is to remove all non-printable characters:
rectext = System.Text.RegularExpressions.Regex.Replace(rectext, _
"[^\u0020-\u007F]", String.Empty)
The whole Sub would read like this:
Private Sub read()
Dim rec(client.ReceiveBufferSize) As Byte
stream.Read(rec, 0, client.ReceiveBufferSize)
Dim rectext As String = System.Text.Encoding.ASCII.GetString(rec)
If rectext.Contains("#1#") Then
rectext = rectext.Substring(3)
If rectext.Split(CChar("-"))(0).Length = 2 Then rectext = "0" & rectext
If rectext.Split(CChar("-"))(0).Length = 1 Then rectext = "00" & rectext
rectext = System.Text.RegularExpressions.Regex.Replace(rectext, "[^\u0020-\u007F]", String.Empty)
listbox_highscores.Items.Add(rectext)
ElseIf rectext.Contains("#2#") Then
Dim tosend As String = listbox_highscores.Items(0).ToString
For i As Integer = 1 To (listbox_highscores.Items.Count - 1)
tosend &= "," & listbox_highscores.Items(i).ToString
Next
SendMessage(tosend)
End If
tmr.Start()
End Sub
Try this, your comma's are off as well...
Dim tosend As String = String.Empty
Dim intCount As Integer = 0
For i As Integer = 0 To listbox.Items.Count - 1
If intCount >= 1 Then
tosend &= "," & listbox.Items(i).ToString
Else
tosend &= listbox.Items(i).ToString
intCount += 1
End If
Next
MessageBox.Show(tosend)
Screenshot THAT IT WORKS!