we are building postcards and I need the image to be on the second page, so the printer will do duplex printing and we'll have image on one side and text on the other
Imports System.Drawing
Imports System.Drawing.Printing
Public Class trial : Inherits Printing.PrintDocument
Dim text As String
Dim font As Font
Dim leftText As String
Dim pic As Image
Dim paper As PaperSize
Dim printNewPage As Boolean = True
Dim page1 As Boolean = True
Sub New(ByVal lefty As String, ByVal nam As String, ByVal add As String, ByVal cit As String, ByVal zi As String, ByVal pi As Image, ByVal ps As PaperSize)
font = New Font("Arial", 12)
text = nam & Environment.NewLine & add & Environment.NewLine & cit & ", IN" & Environment.NewLine & zi
paper = ps
leftText = lefty
pic = pi
End Sub
Protected Overrides Sub onPrintPage(ByVal e As Printing.PrintPageEventArgs)
MyBase.OnPrintPage(e)
MyBase.DefaultPageSettings.PaperSize = paper
If page1 Then
printLeft(e)
printright(e)
End If
If printNewPage Then
e.HasMorePages = True
printFront(e)
Else
e.HasMorePages = False
End If
End Sub
Private Sub printLeft(ByVal e As Printing.PrintPageEventArgs)
Dim area As RectangleF = New RectangleF(20, 20, 150, 400)
Dim format As StringFormat = New StringFormat(StringFormatFlags.LineLimit)
e.Graphics.DrawString(leftText, font, Brushes.Black, area, format)
e.Graphics.DrawLine(Pens.Black, 200, 20, 200, 399)
End Sub
Private Sub printright(ByVal e As Printing.PrintPageEventArgs)
Dim area As RectangleF = New RectangleF(200, 20, 200, 400)
Dim format As StringFormat = New StringFormat(StringFormatFlags.LineLimit)
e.Graphics.DrawString(text, font, Brushes.Black, area, format)
page1 = False
End Sub
Private Sub printFront(ByVal e As Printing.PrintPageEventArgs)
MyBase.OnPrintPage(e)
Dim area As RectangleF = New RectangleF(20, 500, 400, 400)
e.Graphics.DrawImage(pic, area)
printNewPage = False
End Sub
End Class
If the printer is set to do duplex printing by default then duplex printing will occur automatically if you print a document that is more than one page. You need to have a look at the PrintPageEventArgs.HasMorePages property. You need to set this to True after printing the first page.
Related
I am trying to write (type) directly onto a bitmap. I need to be able to type at the mouse position, so where ever on the screen i click the mouse, I can start typing text with the keyboard.
Here is a working VS 2017 VB Win Form code that will print "Hello World" at the mousedown position. But it only works with predetermined text. I would like to be able to just type at that spot. I feel I am so close, just can't get it to work.
Imports System.IO
Imports System.Windows.Forms.DataVisualization.Charting
Public Class Form1
Dim WithEvents Chart1 As New Chart
Private Structure TextPoints
Dim MPos As Point
Dim Txt As String
End Structure
Private TextList As New List(Of TextPoints)
Private TempPoint As Point
Private FirstPoint As Point
Dim xcnt As Integer = -1
Dim ycnt As Integer = -1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.Size = New Size(1100, 700)
Me.Location = New Point(10, 10)
MakeBackImage()
With Chart1
.Name = "Chart1"
.Location = New System.Drawing.Point(40, 40)
.Size = New System.Drawing.Size(1010, 610)
.BackImage = "BackImg.jpg"
.Parent = Me
End With
End Sub
Private Sub Chart1_MouseDown(ByVal sender As Object,
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles Chart1.MouseDown
FirstPoint = New Point(e.X, e.Y)
TempPoint = New Point(e.X, e.Y)
Me.Refresh()
End Sub
Private Sub Chart1_MouseUp(ByVal sender As Object,
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles Chart1.MouseUp
Dim T As New TextPoints With {
.MPos = TempPoint,
.Txt = "Hello World"}
TextList.Add(T)
Me.Refresh()
End Sub
Private Sub MakeBackImage()
Dim x, y As Integer
Dim img As Image = New Bitmap(1020, 620)
Dim graphics As Graphics = Graphics.FromImage(img)
graphics.Clear(Drawing.Color.White)
For x = 0 To 1000 Step 20
graphics.DrawLine(Pens.Black, x, 0, x, 600)
xcnt += 1
Next
For y = 0 To 600 Step 20
ycnt += 1
graphics.DrawLine(Pens.Black, 0, y, 1000, y)
Next
img.Save("BackImg.jpg", Imaging.ImageFormat.Jpeg)
End Sub
Private Sub Chart1_Paint(ByVal sender As Object,
ByVal e As System.Windows.Forms.PaintEventArgs) _
Handles Chart1.Paint
Dim drawString As String = "Hello World"
Dim drawFont As New Font("Arial", 14)
Dim drawBrush As New SolidBrush(Color.Black)
For Each t As TextPoints In TextList
e.Graphics.DrawString(t.Txt, drawFont,
drawBrush, t.MPos.X, t.MPos.Y)
Next
End Sub
End Class
This is a simplified code. Actually, the background image is only created once, but I added code to dynamically create it here to make the demo better.
I'm experimenting on paint event in Windows Form, what I want to achieved is to repaint the colors of the arrow. I think I successfully did that, I just have a question on whether should I use the Me.Invalidate or Me.Refresh when performing the repaint event on the form? Both of them are working.
Note that I will create many objects later so one of my goals is to lessen the performance issues.
When you clicked the button 1 it will change the color of the line 1 to yellow using the Me.Invalidate, when you clicked the button 2 it will change the line 1 to blue using the Me.Refresh. Both of them are working.
This is my whole code:
Public Class Form1
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint
drawLeftArrow(e, "a", 100, 250, 400, 50)
End Sub
Dim aPen As Pen = New Pen(Color.Red, 8)
Dim bPen As Pen
Dim cPen As Pen
Dim line1 As Point()
Dim line2 As Point()
Dim line3 As Point()
Sub drawLeftArrow(e As PaintEventArgs, letterPosition As String, startPointX As Integer, startPointY As Integer, endPointX As Integer, endPointY As Integer)
bPen = New Pen(Color.Green, 8)
cPen = New Pen(Color.Yellow, 8)
Dim mycap As Drawing2D.CustomLineCap = New Drawing2D.AdjustableArrowCap(5, 5)
' Create points that define curve.
Dim startPoint As New Point(startPointX, startPointY)
Dim endPoint As New Point(endPointX, endPointY)
Select Case letterPosition
Case "a"
Dim middlePoint1 As New Point(startPointX + 250, startPointY)
Dim middlePoint2 As New Point(startPointX + 300, endPointY + 150)
line1 = {startPoint, middlePoint1}
line2 = {middlePoint1, middlePoint2}
line3 = {middlePoint2, endPoint}
cPen.CustomEndCap = mycap
' Draw lines between original points to screen.
e.Graphics.DrawLines(aPen, line1)
e.Graphics.DrawLines(bPen, line2)
e.Graphics.DrawLines(cPen, line3)
Exit Select
End Select
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
aPen = New Pen(Color.Yellow, 8)
Me.Invalidate()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
aPen = New Pen(Color.Blue, 8)
Me.Refresh()
End Sub
End class
Output:
I've used a background worker to launch an application, wait for cancellation and then close the application. But for some reason the application never closes. I've tried with and without notificationPreview.WaitForExit()
Private Sub bgWorker_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles bgWorker.DoWork
'Extract the executable to the applications directory path and execute it
Dim notificationPreview As New Process
Dim monitorExe As Byte() = My.Resources.ITSupportMonitoring
My.Computer.FileSystem.WriteAllBytes(My.Application.Info.DirectoryPath & "ITSupportMonitoring.exe", monitorExe, False)
notificationPreview = Process.Start(My.Application.Info.DirectoryPath & "ITSupportMonitoring.exe")
notificationPreview.WaitForInputIdle()
'Wait until the worker is sent a cancellation request
Do Until bgWorker.CancellationPending = True
System.Threading.Thread.Sleep(500)
Loop
'If the process hasn't been closed by the user close it
If Not notificationPreview.HasExited Then 'If the process is still running
notificationPreview.CloseMainWindow() 'Tell the main window of the notification process to close
notificationPreview.WaitForExit()
notificationPreview.Close() 'Free all resources used by the notification process
End If
My.Computer.FileSystem.DeleteFile(My.Application.Info.DirectoryPath & "ITSupportMonitoring.exe") 'Delete the executable file
e.Cancel = True
End Sub
Here is the FULL code for the process which will not close:
Public Class frmMonitoring
Dim noticeText As String
Private Sub frmMonitoring_Load(sender As Object, e As EventArgs) Handles Me.Load
'Set the notice text
If My.Application.CommandLineArgs.Count > 0 Then
noticeText = My.Application.CommandLineArgs(0)
Else
noticeText = "Example String"
End If
Me.ForeColor = Color.Black
tmrFlash.Interval = 1000
tmrFlash.Start()
Me.Top = 0
Me.Left = 0
Me.TopMost = True
End Sub
Private Sub tmrFlash_Tick(sender As Object, e As EventArgs) Handles tmrFlash.Tick
If Me.ForeColor = Color.Black Then
Me.ForeColor = Color.Red
Else
Me.ForeColor = Color.Black
End If
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)
Dim drawFont As New System.Drawing.Font(SystemFonts.DefaultFont.Name, 16)
Dim drawBrush As New System.Drawing.SolidBrush(Me.ForeColor)
Dim drawFormat As New System.Drawing.StringFormat
Dim drawRect As New RectangleF(e.ClipRectangle.Location, e.ClipRectangle.Size)
drawRect.Height = drawRect.Height * 0.65 'The bottom line of text was getting partially clipped, so reduced the height of the drawing area to 65%
drawFont = GetAdjustedFont(e.Graphics, noticeText, drawFont, drawRect, 40, 4, True)
Dim stringFormat As New StringFormat(StringFormatFlags.NoClip)
stringFormat.Alignment = StringAlignment.Center
stringFormat.LineAlignment = StringAlignment.Center
e.Graphics.DrawString(noticeText, drawFont, drawBrush, RectangleF.op_Implicit(ClientRectangle), stringFormat)
drawFont.Dispose()
drawBrush.Dispose()
End Sub
Public Function GetAdjustedFont(ByRef GraphicRef As Graphics, ByVal GraphicString As String, ByVal OriginalFont As Font, ByVal ContainerSize As RectangleF, ByVal MaxFontSize As Integer, ByVal MinFontSize As Integer, ByVal SmallestOnFail As Boolean) As Font
'Loop through font sizes and MeasureString to find the largest font which can be used
For AdjustedSize As Integer = MaxFontSize To MinFontSize Step -1
Dim TestFont = New Font(OriginalFont.Name, AdjustedSize, OriginalFont.Style)
Dim charsFitted As Integer
Dim linesFilled As Integer
' Test the string with the new size
Dim AdjustedSizeNew = GraphicRef.MeasureString(GraphicString, TestFont, ContainerSize.Size, New StringFormat, charsFitted, linesFilled)
If charsFitted = GraphicString.Length Then 'If every characted in the string was printed
'Good font, return it
Return TestFont 'New Font(TestFont.Name, TestFont.Size - 1, TestFont.Style)
End If
Next
' If you get here there was no fontsize that worked
' return MinimumSize or Original?
If SmallestOnFail Then
Return New Font(OriginalFont.Name, MinFontSize, OriginalFont.Style)
Else
Return OriginalFont
End If
End Function
End Class
I am reading from a text file and then printing the string using printdocument via vb.net 2010.
Here is my code :
Public Class myPrinter
Friend TextToBePrinted As String
Public Sub prt(ByVal text As String)
Dim psize As New System.Drawing.Printing.PaperSize("Custom Paper Size", 850, 550)
Dim newMargins As New System.Drawing.Printing.Margins(0, 0, 0, 0)
TextToBePrinted = text
Dim prn As New Printing.PrintDocument
Using (prn)
prn.PrinterSettings.PrinterName = frmStockOut.printer
prn.PrinterSettings.Copies = frmStockOut.copies
prn.PrinterSettings.DefaultPageSettings.PaperSize = psize
prn.PrinterSettings.DefaultPageSettings.Margins = newMargins
prn.DefaultPageSettings.PaperSize = psize
prn.DefaultPageSettings.Margins = newMargins
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 myFont As New Font("Courier New", 11)
args.Graphics.DrawString(TextToBePrinted, _
New Font(myFont, FontStyle.Regular), _
Brushes.Black, 50, 50)
End Sub
End Class
Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim charactersOnPage As Integer = 0
Dim linesPerPage As Integer = 0
' Sets the value of charactersOnPage to the number of characters
' of stringToPrint that will fit within the bounds of the page.
e.Graphics.MeasureString(stringToPrint, Me.Font, e.MarginBounds.Size, _
StringFormat.GenericTypographic, charactersOnPage, linesPerPage)
' Draws the string within the bounds of the page
e.Graphics.DrawString(stringToPrint, Me.Font, Brushes.Black, _
e.MarginBounds, StringFormat.GenericTypographic)
' Remove the portion of the string that has been printed.
stringToPrint = stringToPrint.Substring(charactersOnPage)
' Check to see if more pages are to be printed.
e.HasMorePages = stringToPrint.Length > 0
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
ReadFile() ' will read text file and store in a string
Dim Print As New myPrinter
Dim myprintdialog As New PrintDialog
With myprintdialog
If .ShowDialog = Windows.Forms.DialogResult.OK Then
printer = .PrinterSettings.PrinterName
copies = .PrinterSettings.Copies
Print.prt(stringToPrint)
End If
End With
End Sub
The problem is even after I set the left margin and top margin to 0, it seems nothing has changed, it is still printing almost 3/4 inch for top margins and 1 inch for the left margin. This is also the output when I didn't set the margins. However, when I prn.OriginAtMargins = True , the output becomes a little different, left margin is now almost 1/2 inch but top margin remains the same. Something wrong with my code?
What I want to accomplish is the top margin can be set at approximately 20 pixels (assuming 100 pixels is equal to 1 inch) and left margin be set at 20 pixels too. Hope somebody can help me.
I have a problem in flipping text in VB.NET
It is flipped but with no line brake
See the Link:
http://www.spider-news.net/Flip_Text_question.JPG
Imports System.Drawing.Drawing2D
Imports System.Drawing
Public Class Form1
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
' Draw the text and the surrounding rectangle START.
Dim text1 As String = RichTextBox1.Text
Dim font1 As New Font("Arial", 10, FontStyle.Bold, GraphicsUnit.Point)
Try
Dim rect1 As New Rectangle(10, 10, 1000, 140)
' Create a StringFormat object with the each line of text, and the block
' of text centered on the page.
Dim stringFormat As New StringFormat()
stringFormat.Alignment = StringAlignment.Center
stringFormat.LineAlignment = StringAlignment.Center
' Draw the text and the surrounding rectangle.
e.Graphics.DrawString(text1, font1, Brushes.Blue, rect1, stringFormat)
e.Graphics.DrawRectangle(Pens.Black, rect1)
Finally
font1.Dispose()
End Try
' Draw the text and the surrounding rectangle END.
'' FLIP TEXT ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Draw Flipped Text the text surrounding rectangle START.
Using the_font As New Font("Arial", 20, FontStyle.Bold, GraphicsUnit.Point)
DrawFlippedText(e.Graphics, the_font, Brushes.Black, 10, 10, RichTextBox1.Text, True, False)
Dim txt_size As SizeF
txt_size = e.Graphics.MeasureString(RichTextBox1.Text, the_font)
e.Graphics.DrawRectangle(Pens.Red, 10, 10, txt_size.Width, txt_size.Height)
End Using
' Draw Flipped Text the text surrounding rectangle END.
'' FLIP TEXT ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
Public Sub DrawFlippedText(ByVal gr As Graphics, ByVal the_font As Font, ByVal the_brush As Brush, ByVal x As Integer, ByVal y As Integer, ByVal txt As String, ByVal flip_x As Boolean, ByVal flip_y As Boolean)
' Save the current graphics state.
Dim state As GraphicsState = gr.Save()
' Set up the transformation.
Dim scale_x As Integer = IIf(flip_x, -1, 1)
Dim scale_y As Integer = IIf(flip_y, -1, 1)
gr.ResetTransform()
gr.ScaleTransform(scale_x, scale_y)
' Figure out where to draw.
Dim txt_size As SizeF = gr.MeasureString(txt, the_font)
If flip_x Then x = -x - RichTextBox1.Size.Width
If flip_y Then y = -y - RichTextBox1.Size.Height
Dim rect1 As New Rectangle(10, 10, 1000, 140)
Dim stringFormat As New StringFormat()
stringFormat.Alignment = StringAlignment.Center
stringFormat.LineAlignment = StringAlignment.Center
' Draw.
gr.DrawString(txt, the_font, the_brush, x, y)
' Restore the original graphics state.
gr.Restore(state)
End Sub
End Class
Please HELP
My guess is that if the linebreaks are not there you have to split the string into single words.
Then concatenate the words one by one and measure the lenght. if it exceeds your line width draw this string and continue with the next words.
The next draw should be on y-coordinate + your line-height.
I did this in a pdf where i place a text to an absolute position which could be more than 1 line:
Dim splitted As String() = text.Split()
Dim tempchunk As Chunk = New Chunk("", pdfFont)
Dim count As Integer = 0
For Each s As String In splitted
Dim chunk2 As Chunk
chunk2 = New Chunk(tempchunk.Content, pdfFont)
chunk2.Append(" " & s)
If chunk2.GetWidthPoint() > 155 Then
cb.SaveState()
cb.BeginText()
cb.MoveText(x, y - (13 * count))
cb.SetFontAndSize(bfont, 11)
cb.ShowText(tempchunk.Content.Trim())
cb.EndText()
cb.RestoreState()
tempchunk = New Chunk(s, pdfFont)
count += 1
Else
tempchunk.Append(" " & s)
End If
Next
If tempchunk.Content <> "" Then
cb.SaveState()
cb.BeginText()
cb.MoveText(x, y - (13 * count))
cb.SetFontAndSize(bfont, 11)
cb.ShowText(tempchunk.Content.Trim())
cb.EndText()
cb.RestoreState()
End If
Its the code for the pdf but maybe it helps
Try this.
I created a bitmap, draw the string and rectangle there, flipped it, then draw the bitmap (with flipped text) on the Form.
Public Class Form1
Private Sub RichTextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox1.TextChanged
Dim b As New Bitmap(300, 100)
Dim g As Graphics = Graphics.FromImage(b)
Dim d As Graphics = Me.CreateGraphics
Dim r As New Rectangle(0, 0, b.Width - 1, b.Height - 1)
Dim f As New StringFormat
f.Alignment = StringAlignment.Center
f.LineAlignment = StringAlignment.Center
g.Clear(BackColor)
g.DrawRectangle(Pens.Red, r)
g.DrawString(RichTextBox1.Text, RichTextBox1.Font, Brushes.Blue, r, f)
b.RotateFlip(RotateFlipType.RotateNoneFlipX)
d.DrawImageUnscaled(b, 10, 10)
g.Dispose()
b.Dispose()
d.Dispose()
End Sub
End Class