I have a program which writes to a .log file as it is installing software.
Some of the lines will contain either WARNING or FAILED.
What I would like, is a window in my program which will read the .log file and display the content into this window as it is being written too. Any lines which contain WARNING or FAILED in them are highlighted yellow/red.
Does anyone know how to do this?
Create a FORM (I used VB 2010) and add this code.
it will write 3 lines on the form in 2 colours.
It might get you on your way. Ask MSDN help for each function that is new to you.
Private Sub Form1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim chRs(0) As CharacterRange
Dim sbRs(0) As SolidBrush
Dim flRs(0) As SolidBrush
Dim blueBrush As New SolidBrush(Color.Blue)
Dim whiteBrush As New SolidBrush(Color.White)
Dim redBrush As New SolidBrush(Color.Red)
Dim EditFont As New Font("Courier New", 9)
Dim stringFormat As New StringFormat
Dim aRectangle As Rectangle
Dim RectHeight As Integer = 20
For i = 1 To 3
Dim txt As String = "a string " & CStr(i)
If i = 2 Then
sbRs(0) = blueBrush
Else
sbRs(0) = redBrush
End If
flRs(0) = whiteBrush
chRs(0) = New CharacterRange(0, txt.Length())
Dim chRsa As Array = Array.CreateInstance(GetType(CharacterRange), 1)
Array.Copy(chRs, 0, chRsa, 0, 1)
aRectangle = New Rectangle(0, CInt((i - 1) * RectHeight), ClientRectangle.Size.Width, RectHeight) ' x, y, w, h
stringFormat.SetMeasurableCharacterRanges(chRsa)
Dim stringRegions As Array = Array.CreateInstance(GetType([Region]), 1)
stringRegions = e.Graphics.MeasureCharacterRanges(txt, EditFont, aRectangle, stringFormat)
Dim measureRect1 As RectangleF = stringRegions(0).GetBounds(e.Graphics)
Dim g As Graphics = e.Graphics
g.FillRectangle(flRs(0), measureRect1)
g.DrawString(txt.Substring(chRs(0).First, chRs(0).Length), EditFont, sbRs(0), CSng(measureRect1.X), CSng(measureRect1.Y))
Next
End Sub
Related
I am developing a website where i'm pulling some data from a query and then needing to print this data to a brady pr300 plus label printer. I would like for the printing to happen automatically from the web server to the printer without having the print dialog box pop up on the client computer.
What is the best way to go about this? javascript, vb behind code?
I've been playing around with this without much luck. I created a printingclass with onbeginprint method and onprintpage method. When i call the print, it goes to the onbeginprint method, but for some reason it doesnt go to onprintpagemethod when i step through the code. The error i get is System.Drwaing.Printing.invalidprinterexception: no printers are installed.
I'm kind of stuck at the moment.
Public Sub PrintDocument()
Dim tprinter As New PCPrint
tprinter.PrinterFont = New Font("Verdana", 10)
tprinter.TextToPrint = "HELLO WORLD"
tprinter.PrintName = "testbrady"
tprinter.Print()
End Sub
Protected Overrides Sub OnBeginPrint(ByVal e As Printing.PrintEventArgs)
' Run base code
MyBase.OnBeginPrint(e)
'Check to see if the user provided a font
'if they didnt then we default to Times New Roman
If _font Is Nothing Then
'Create the font we need
_font = New Font("Times New Roman", 10)
End If
End Sub
Protected Overrides Sub OnPrintPage(ByVal e As Printing.PrintPageEventArgs)
' Run base code
MyBase.OnPrintPage(e)
'Declare local variables needed
Static curChar As Integer
Dim printHeight As Integer
Dim printWidth As Integer
Dim leftMargin As Integer
Dim rightMargin As Integer
Dim lines As Int32
Dim chars As Int32
'Set print area size and margins
With MyBase.DefaultPageSettings
printHeight = .PaperSize.Height - .Margins.Top - .Margins.Bottom
printWidth = .PaperSize.Width - .Margins.Left - .Margins.Right
leftMargin = .Margins.Left 'X
rightMargin = .Margins.Top 'Y
End With
MyBase.DefaultPageSettings.PrinterSettings.PrinterName = PrintName
'Check if the user selected to print in Landscape mode
'if they did then we need to swap height/width parameters
If MyBase.DefaultPageSettings.Landscape Then
Dim tmp As Integer
tmp = printHeight
printHeight = printWidth
printWidth = tmp
End If
'Now we need to determine the total number of lines
'we're going to be printing
Dim numLines As Int32 = CInt(printHeight / PrinterFont.Height)
'Create a rectangle printing are for our document
Dim printArea As New RectangleF(leftMargin, rightMargin, printWidth, printHeight)
'Use the StringFormat class for the text layout of our document
Dim format As New StringFormat(StringFormatFlags.LineLimit)
'Fit as many characters as we can into the print area
e.Graphics.MeasureString(_text.Substring(RemoveZeros(curChar)), PrinterFont, New SizeF(printWidth, printHeight), format, chars, lines)
'Print the page
e.Graphics.DrawString(_text.Substring(RemoveZeros(curChar)), PrinterFont, Brushes.Black, printArea, format)
'Increase current char count
curChar += chars
'Detemine if there is more text to print, if
'there is the tell the printer there is more coming
If curChar < _text.Length Then
e.HasMorePages = True
Else
e.HasMorePages = False
curChar = 0
End If
End Sub
Hello StackOverflow Members,
This is what i ended up doing to get the label printer to work.
Imports System.Drawing
Imports System.Drawing.Printing
Public Sub prt(variables)
Dim prn As New Printing.PrintDocument
Dim psz As New Printing.PaperSize With {
.RawKind = Printing.PaperKind.Custom,
.Width = 400,
.Height = 150
}
Using (prn)
prn.PrinterSettings.PrinterName = printer
prn.DefaultPageSettings.PaperSize = psz
prn.DefaultPageSettings.Margins.Left = 5
prn.DefaultPageSettings.Margins.Right = 5
prn.DefaultPageSettings.Margins.Top = 5
prn.DefaultPageSettings.Margins.Bottom = 5
AddHandler prn.PrintPage,
AddressOf Me.PrintPageHandler
prn.Print()
RemoveHandler prn.PrintPage,
AddressOf Me.PrintPageHandler
End Using
End Sub
Private Sub PrintPageHandler(ByVal sender As Object,
ByVal args As Printing.PrintPageEventArgs)
Dim shopnameX As Integer = 10, shopnameY As Integer = 10
Dim sfont As New Font("Arial Black", 14)
Dim strfomart As New StringFormat()
Dim StrRight As New StringFormat()
Dim StrLeft As New StringFormat()
strfomart.Alignment = StringAlignment.Center
StrRight.Alignment = StringAlignment.Far
StrLeft.Alignment = StringAlignment.Near
Dim dashValues As Single() = {5, 2, 5, 2}
Dim blackPen As New Pen(Color.Black, 1)
' blackPen.DashPattern = dashValues
Dim i As Integer, j As Integer
args.Graphics.DrawString(part.ToString, sfont, Brushes.Black, New
PointF(shopnameX, shopnameY))
End Sub
I have created a routine that is intended to print a variable number of lines and/or pages, based on a queue of line information previously stored. Each page prints fine, but when printing more than one page, two pages overprint. I can't see my logic error, but there must be one. A copy of the offending code is follows. Nextline.newpage is a boolean set to true to force a new page. In my text example there were six "Newpage" and "hasmorepages" was set to true six times, and the routine was exited six times. Still the output was four pages with one printing correctly, and three with two pages printed on one sheet. Any help would be greatly appreciated. By the way, this is my first question, so be kind.
Private Sub PrintLines(Sender As Object, e As PrintPageEventArgs) Handles PrintDoc.PrintPage
Dim White As String = GetARGBString(PrinterDefaultBackcolor)
Do Until Lines.Count = 0
Dim Nextline As Lineformat = Lines.Dequeue
If Nextline.NewPage Then
e.HasMorePages = True
Exit Sub
End If
With Nextline
Dim LineBackColor As String = Nextline.backColor
If LineBackColor <> White Or .Borders = True Then DrawShape(Nextline, e)
If .Text <> "" Then DrawText(Nextline, e)
End With
Loop
End Sub
Private Sub DrawShape(Line As Lineformat, E As PrintPageEventArgs)
With Line
Dim Top As Integer = .Top * 100
Dim Left As Integer = .Left * 100
Dim Width As Integer = .BackGroundWidth * 100
Dim Height As Integer = .BackGroundHeight * 100
Dim Point As New Point(Left, Top)
Dim Size As New Size(Width, Height)
Dim Rect As New Rectangle(Point, Size)
Dim TransparentFillColor As String = "00" & Strings.Right(.backColor, 6)
Dim FillColor As FullColor = GetColorFromString(.backColor)
Dim BorderPen As New Pen(Color.Black)
Dim FillBrush As New SolidBrush(FillColor.Color)
E.Graphics.FillRectangle(FillBrush, Rect)
If Line.Borders = True Then
E.Graphics.DrawRectangle(BorderPen, Rect)
End If
End With
End Sub
Private Sub DrawText(Line As Lineformat, E As PrintPageEventArgs)
With Line
Dim MyFont = SetFontStyle(.FontFamily, .FontPoints, .FontBold, .FontItalic, .FontUnderline)
Dim TextColor As FullColor = GetColorFromString(.ForeColor)
Dim MyBrush As New SolidBrush(TextColor.Color)
Dim top As Integer = .Top * 100
Dim Left As Integer = .Left * 100
Dim Width As Integer = .LineWidth * 100
Dim Height As Integer = .LineHeight * 100
Dim point As New Point(Left, top)
Dim Size As New Size(Width, Height)
Dim Rect As New RectangleF(point, Size)
Dim SF As New StringFormat()
SF.FormatFlags = TextFormatFlags.WordEllipsis
E.Graphics.DrawString(.Text, MyFont, MyBrush, Rect, SF)
End With
End Sub
End Class
I've had little luck trying to find the answer to this either on stackoverflow specifically, or on the internet in general.
I have a form in a vb 2015 Windows Forms project.
On that form, I've placed six controls: four textboxes, a panel, and a button.
When I click the button, it generates a bitmap, like so:
Private Sub btnSetLeft_Click(sender As Object, e As EventArgs) Handles btnSetLeft.Click
Dim R As Integer = CInt(txtRedLeft.Text)
Dim G As Integer = CInt(txtGreenLeft.Text)
Dim B As Integer = CInt(txtBlueLeft.Text)
Dim A As Integer = CInt(txtAlphaLeft.Text)
gcL = Color.FromArgb(A, R, G, B)
Using bm As Bitmap = New Bitmap(9, 9)
Using gBM As Graphics = Graphics.FromImage(bm)
Using br As SolidBrush = New SolidBrush(gcL)
gBM.FillRectangle(br, New Rectangle(0, 0, 8, 8))
End Using
End Using
End Using
End Sub
But, after building the bitmap, I want the button to place the bitmap on the panel and then repaint the panel, thus displaying the new bitmap.
How do I do that?
It's not too hard (I simplified your example):
Dim gcL As Color = Color.Blue
Using bm As New Bitmap(9, 9)
Using gBM As Graphics = Graphics.FromImage(bm)
Using br As New SolidBrush(gcL)
gBM.FillRectangle(br, New Rectangle(0, 0, 8, 8))
End Using
End Using
panel1.BackgroundImage = bm
panel1.BackgroundImageLayout = ImageLayout.Tile
panel1.Update()
End Using
Edit: I found another example that creates the encoder params like this and I get the exact same error as befoer: "A generic error occurred in GDI+"
Dim info As ImageCodecInfo = Nothing
Dim ice As ImageCodecInfo
For Each ice In ImageCodecInfo.GetImageEncoders()
If ice.MimeType = "image/tiff" Then
info = ice
End If
Next ice 'use the save encoder
Dim enc As Encoder = Encoder.SaveFlag
Dim ep As New EncoderParameters(1)
ep.Param(0) = New EncoderParameter(enc, CLng(EncoderValue.MultiFrame))
ORIGINAL POST
VB.Net, Visual Studio 2012, .Net 4.5
I have been trying to write, borrow, or steal code that will merge multiple TIFF files in to a single tiff file. Every example, whether I write or get it from someplace fails on the same line with the exception, "A generic error occurred in GDI+". The line that causes the problem is DestinationImage.SaveAdd(img, imagePararms). There is just not enough to go on with that generic error message about a generic error. Has anyone experienced this?
Greg
Public Sub mergeTiffPages(str_DestinationPath As String, sourceFiles As String())
Dim codec As System.Drawing.Imaging.ImageCodecInfo = Nothing
For Each cCodec As System.Drawing.Imaging.ImageCodecInfo In System.Drawing.Imaging.ImageCodecInfo.GetImageEncoders()
If cCodec.CodecName = "Built-in TIFF Codec" Then
codec = cCodec
End If
Next
Try
Dim imagePararms As New System.Drawing.Imaging.EncoderParameters(1)
imagePararms.Param(0) = New System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(System.Drawing.Imaging.EncoderValue.MultiFrame))
If sourceFiles.Length = 1 Then
System.IO.File.Copy(DirectCast(sourceFiles(0), String), str_DestinationPath, True)
ElseIf sourceFiles.Length >= 1 Then
Dim DestinationImage As System.Drawing.Image = DirectCast(New System.Drawing.Bitmap(DirectCast(sourceFiles(0), String)), System.Drawing.Image)
DestinationImage.Save(str_DestinationPath, codec, imagePararms)
imagePararms.Param(0) = New System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(System.Drawing.Imaging.EncoderValue.FrameDimensionPage))
For i As Integer = 0 To sourceFiles.Length - 2
Dim img As System.Drawing.Image = DirectCast(New System.Drawing.Bitmap(DirectCast(sourceFiles(i), String)), System.Drawing.Image)
DestinationImage.SaveAdd(img, imagePararms)
img.Dispose()
Next
imagePararms.Param(0) = New System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(System.Drawing.Imaging.EncoderValue.Flush))
DestinationImage.SaveAdd(imagePararms)
imagePararms.Dispose()
DestinationImage.Dispose()
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Although I did not find a solution for this code I did find code that works. JohnH a moderator at http://www.vbdotnetforums.com/ posted the code below in this thread http://www.vbdotnetforums.com/graphics-gdi/22113-create-multipage-tiff-loop.html
It works for me. I added a few lines at the top to show how I called it.
Greg
'Example: Combine 4 tiff images in a new file called FinishedTiff.tiff
'Dim oNewImage As Image
'oNewImage = Image.FromFile("C:\IRISScan\Week of Jan 6 no SSN_Page_1.tif")
'SaveAddTiff(oNewImage, "C:\IRISScan\FinishedTiff.tif")
'oNewImage = Image.FromFile("C:\IRISScan\Week of Jan 6 no SSN_Page_2.tif")
'SaveAddTiff(oNewImage, "C:\IRISScan\FinishedTiff.tif")
'oNewImage = Image.FromFile("C:\IRISScan\Document3_Page_1.tif")
'SaveAddTiff(oNewImage, "C:\IRISScan\FinishedTiff.tif")
'oNewImage = Image.FromFile("C:\IRISScan\Document3_Page_2.tif")
'SaveAddTiff(oNewImage, "C:\IRISScan\FinishedTiff.tif")
Imports System.Drawing.Imaging
Module modTiff
'
Sub SaveAddTiff(ByVal img As Image, ByVal filename As String)
If Not IO.File.Exists(filename) Then
img.Save(filename, Imaging.ImageFormat.Tiff)
Else
Dim frames As List(Of Image) = getFrames(filename)
frames.Add(img)
SaveMultiTiff(frames.ToArray, filename)
End If
img.Dispose()
End Sub
Sub SaveMultiTiff(ByVal frames() As Image, ByVal filename As String)
Dim codec As ImageCodecInfo = getTiffCodec()
Dim enc As Encoder = Encoder.SaveFlag
Dim ep As New EncoderParameters(2)
ep.Param(0) = New EncoderParameter(enc, CLng(EncoderValue.MultiFrame))
ep.Param(1) = New EncoderParameter(Encoder.Compression, CLng(EncoderValue.CompressionNone))
Dim tiff As Image = frames(0)
tiff.Save(filename, codec, ep)
ep.Param(0) = New EncoderParameter(enc, CLng(EncoderValue.FrameDimensionPage))
For i As Integer = 1 To frames.Length - 1
tiff.SaveAdd(frames(i), ep)
frames(i).Dispose()
Next
ep.Param(0) = New EncoderParameter(enc, CLng(EncoderValue.Flush))
tiff.SaveAdd(ep)
tiff.Dispose()
End Sub
Function getTiffCodec() As ImageCodecInfo
For Each ice As ImageCodecInfo In ImageCodecInfo.GetImageEncoders()
If ice.MimeType = "image/tiff" Then
Return ice
End If
Next
Return Nothing
End Function
Function getFrames(ByVal filename) As List(Of Image)
Dim frames As New List(Of Image)
Dim img As Image = Image.FromFile(filename)
For i As Integer = 0 To img.GetFrameCount(Imaging.FrameDimension.Page) - 1
img.SelectActiveFrame(Imaging.FrameDimension.Page, i)
Dim tmp As New Bitmap(img.Width, img.Height)
Dim g As Graphics = Graphics.FromImage(tmp)
g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
g.DrawImageUnscaled(img, 0, 0)
frames.Add(tmp)
g.Dispose()
Next
img.Dispose()
Return frames
End Function
End Module
I replaced
g.DrawImageUnscaled(img, 0, 0)
with
g.DrawImageUnscaledAndClipped(img, New Rectangle(0, 0, img.Width, img.Height))
and it fixed the scaling issue where it would shrink the image to a quarter of its original size
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);