vb.net 2010 PrintDocument Margins not working even if I set the margins - vb.net

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.

Related

Type Text Directly On A Bitmap Image at Mouse Position

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.

Create dyamically re-sizable line\shape winforms

I am new to programming. Can anybody help me with creating line/shape in picturebox with grips on the line/shape. Like we do it in CAD softwares.
And i want to know how to create a line on mouse click until another mouse click event occurs.
Public Class Form1
Dim isDrag As Boolean = False
Dim theRectangle As New Rectangle(New Point(0, 0), New Size(0, 0))
Dim startPoint As Point
Dim IsDimension As Boolean = False
Dim LineLocationStPoint As Point = Nothing
Dim LineLocationEndPoint As Point = Nothing
Dim cnt As Integer = 0
Dim LineArray As New ArrayList
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim fd As OpenFileDialog = New OpenFileDialog()
Dim strFileName As String
fd.Title = "Open File Dialog"
fd.Filter = "(*.PDF;*.DWG;*.TIFF;*.TIF)|*.PDF;*.DWG;*.TIFF;*.TIF|All files (*.*)|*.*"
fd.FilterIndex = 2
fd.RestoreDirectory = True
If fd.ShowDialog() = DialogResult.OK Then
strFileName = fd.FileName
'ShowFileInWebBrowser(WebBrowser1, strFileName)
PictureBox1.Load(strFileName)
End If
End Sub
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
If (e.Button = MouseButtons.Right) Then
isDrag = True
End If
Dim control As Control = CType(sender, Control)
startPoint = control.PointToScreen(New Point(e.X, e.Y))
If (e.Button = MouseButtons.Left) Then
IsDimension = True
LineLocationStPoint = e.Location
LineArray.Add(e.Location)
End If
End Sub
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
If (isDrag) Then
ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
FrameStyle.Dashed)
Dim endPoint As Point = CType(sender, Control).PointToScreen(New Point(e.X, e.Y))
Dim width As Integer = endPoint.X - startPoint.X
Dim height As Integer = endPoint.Y - startPoint.Y
theRectangle = New Rectangle(startPoint.X, startPoint.Y, _
width, height)
ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
FrameStyle.Dashed)
End If
If IsDimension Then
LineLocationEndPoint = e.Location
Dim g As Graphics = PictureBox1.CreateGraphics()
g.DrawLine(Pens.Red, LineLocationStPoint, e.Location)
g.Dispose()
End If
End Sub
Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
If IsDimension Then
PictureBox1.Refresh()
ElseIf isDrag Then
' If the MouseUp event occurs, the user is not dragging.
isDrag = False
' Draw the rectangle to be evaluated. Set a dashed frame style
' using the FrameStyle enumeration.
ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
FrameStyle.Dashed)
' Find out which controls intersect the rectangle and change their color.
' The method uses the RectangleToScreen method to convert the
' Control's client coordinates to screen coordinates.
Dim i As Integer
Dim controlRectangle As Rectangle
For i = 0 To Controls.Count - 1
controlRectangle = Controls(i).RectangleToScreen _
(Controls(i).ClientRectangle)
If controlRectangle.IntersectsWith(theRectangle) Then
Controls(i).BackColor = Color.BurlyWood
End If
Next
' Reset the rectangle.
theRectangle = New Rectangle(0, 0, 0, 0)
End If
End Sub
But it creates the line continuously from selected point. Whereas I want to create a line only for showing user the path of line. And i have implemented selection rectangle an right click button
Procedure for working:
Toolbar will contain line and Area
Open a file(image file)
click on line button of toolbar
*Come to picturebox
*click on one point of screen
*dynamic line starts drawing on screen (line will be from the 1st clicked point to where ever mouse mouse)
*when user clicks the next time the line is created.
click area of toolbar
*come back to picturebox
*operation same like line but when user clicks third point on picture box a shaded rectangle should appear.
http://www.vb-helper.com/howto_2005_line_control.html
For those who want to implement line with resizing grip in it.
For adding re sizable line you need to add a customized control of your own. Use this custom control and add/use it in form for further use.
Thanks everyone for helping

setting up margin in vb.net while printing

i am developing a school management software in which i have given a small handy functionality of a mini notepad so that it can make notice or doc within the software.
I have taken a RichTextBox for this, Now my problem is that when i enter text in richtextbox without giving space in between ( eg. aaaaaaaa..........) continous for 2 lines and when i click on PrintPreview, it leave some space from it start displaying on left but the text leaves the page from right side.
What i want is that i should a margin on both the side i.e. left & right side.
Below is my code on Print Document Click
Private Sub PrintDocument1_PrintPage_1(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim font1 As New Font("Arial", 12, FontStyle.Regular)
'Dim formatF As StringFormat = StringFormat.GenericDefault
'formatF.Alignment = StringAlignment.Center
'formatF.LineAlignment = StringAlignment.Center
e.Graphics.DrawString(RichTextBox1.Text, font:=font1, brush:=Brushes.Black, x:=10, y:=50)
End Sub
So it basically do is represented in below images. Please have a look.
Text in richtextbox
Image of print preview
To print a string within a certain area of the page, specify a Rectangle which should contain the string.
Imports System.Drawing.Printing
Public Class Form1
Dim pd As PrintDocument
Public Sub New()
' This call is required by the designer.
InitializeComponent()
pd = New PrintDocument()
AddHandler pd.PrintPage, AddressOf pd_PrintPage
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim preview = New PrintPreviewDialog()
preview.Document = pd
preview.ShowDialog()
End Sub
Private Sub pd_PrintPage(sender As Object, e As PrintPageEventArgs)
'Create a long sample string
Dim s As New String("a"c, 2048)
'Create a rectangle which describes the area where the string
'should print
Dim r As New Rectangle(50, 50, 500, 500)
'Draw the string
e.Graphics.DrawString(s, Me.Font, Brushes.Black, r)
'Since there is no more data to print, set to False
e.HasMorePages = False
End Sub
End Class

VB.Net Process.CloseMainWindow and Process.Close not working

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

How do I force an Image to the second Page VB

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.