NEED HELP PLEASE ! Saving Picture with ""Drawstring, e.graphic""
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim Bmp As New Bitmap(Width, Height)
Dim objBitmap As New Bitmap(Width, Height)
objBitmap.Save("c:\Prompter\checking2.TIFF")
Dim g As Graphics = Graphics.FromImage(Bmp)
Dim cx As Integer = Width
Dim cy As Integer = Height
Dim pen As New Pen(Color.Black)
Dim rect As New Rectangle(0, 0, Width, Height)
Dim drawFormat As New StringFormat()
drawFormat.Alignment = StringAlignment.Center
drawFormat.LineAlignment = StringAlignment.Center
Dim stringFont As New Font("Arial", 50)
g.DrawString(RichTextBox1.Text, stringFont, New SolidBrush(Color.White), rect, drawFormat)
Bmp.Save("c:\Prompter\checking2.TIFF", Imaging.ImageFormat.Tiff)
Using bmp2 As New Drawing.Bitmap(Width, Height)
DrawToBitmap(Bmp, New Rectangle(0, 0, Bmp.Width, Bmp.Height))
Bmp.Save("c:\Prompter\screenshoot.bmp")
End Using
End Sub
Not saving Picture just BLANK Image is showing !
Try disposing graphics before save ..
g.Dispose()
Bmp.Save("c:\Prompter\checking2.TIFF", Imaging.ImageFormat.Tiff)
Related
I am using this code to take screenshots on a production machine and save them to a folder. each file is about 400 kb in size, and I do not really need good resolution and quality. How can I half the resolution and reduce the jpg quality to save space?
Private Sub TakeScreenShot()
Dim screenSize As Size = New Size(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim screenGrab As New Bitmap(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim g As Graphics = Graphics.FromImage(screenGrab)
g.CopyFromScreen(New Point(0, 0), New Point(0, 0), screenSize)
screenGrab.Save("screenshots\test.jpg", Imaging.ImageFormat.Jpeg)
End Sub
Following this MSDN article, you can set 50% quality like this
Private Sub TakeScreenShot()
Dim screenSize As Size = New Size(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim screenGrab As New Bitmap(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim g As Graphics = Graphics.FromImage(screenGrab)
g.CopyFromScreen(New Point(0, 0), New Point(0, 0), screenSize)
Dim jpgEncoder As System.Drawing.Imaging.ImageCodecInfo = GetEncoder(System.Drawing.Imaging.ImageFormat.Jpeg)
Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality
Dim myEncoderParameters As New Imaging.EncoderParameters(1)
Dim myEncoderParameter As New System.Drawing.Imaging.EncoderParameter(myEncoder, 50&)
myEncoderParameters.Param(0) = myEncoderParameter
screenGrab.Save("screenshots\test.jpg", jpgEncoder, myEncoderParameters)
End Sub
Public Function GetEncoder(ByVal format As ImageFormat) As ImageCodecInfo
Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()
Dim codec As ImageCodecInfo
For Each codec In codecs
If codec.FormatID = format.Guid Then
Return codec
End If
Next codec
Return Nothing
End Function
I want to print a Panel content but the result it's not high quality, I faced the same issue when I try to save a PictureBox image but I solve it with this Img.Setresolution(300, 300)
now I want to increase the quality of the result in any way ( also I tried to take a screenshot then store it in an image and print it I get a small image !! )
i tried this but it doesn't work for me :
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim tmpImg As New Bitmap(Panel1.Width, Panel1.Height)
Using g As Graphics = Graphics.FromImage(tmpImg)
g.CopyFromScreen(Panel1.PointToScreen(New Point(0, 0)), New Point(0, 0), New Size(Panel1.Width, Panel1.Height))
End Using
e.Graphics.DrawImage(tmpImg, 0, 0)
Dim aPS As New PageSetupDialog
aPS.Document = PrintDocument1
'Dim bm As New Bitmap(Panel1.Width, Panel1.Height)
'Panel1.DrawToBitmap(bm, New Rectangle(0, 0, Panel1.Width, Panel1.Height))
'e.Graphics.DrawImage(bm, 0, 0)
'Dim aPS As New PageSetupDialog
'aPS.Document = PrintDocument1
End Sub
I need to put some graphics in one section of a TableLayoutPanel.
I'm doing this by creating a PictureBox in one cell of the TLP.
Can't get two things to work:
1) The initial display is blank! Drawing appears only when you resize the form
2) The resize event doesn't fire equally when expanding the size as compared contracting.
Any suggestions to improve the above two problems would be great!
Here is my code. The form has a 2x2 TableLayoutPanel in it, and one cell of the TLP has a PictureBox in it. Both the TLP and the PictureBox are set to Fill Parent:
Imports System.Drawing.Drawing2D
Public Class Form1
Private g As Graphics
Dim n As Integer = 0
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Debug.Print(String.Format("{0}{0}Form1_Load at {1}", vbCrLf, Now()))
Me.SetDesktopLocation(800, 200)
End Sub
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
n += 1
Debug.Print(String.Format("MyBase.Paint: {0}", n))
DisplayMyStuff()
End Sub
Private Sub PictureBox1_Resize(sender As Object, e As EventArgs) Handles Pict ureBox1.Resize
n += 1
Debug.Print(String.Format("PictureBox1.Resize: {0} PictureBoxSize = {1} / {2}", n, PictureBox1.Width, PictureBox1.Height))
If g IsNot Nothing Then
g.Dispose()
End If
g = PictureBox1.CreateGraphics()
End Sub
Private Sub DisplayMyStuff()
Dim rect1 As Rectangle
Dim rect2 As Rectangle
Dim pt1 As New Point(50, 50)
Dim pt2 As New Point(100, 100)
Dim pt3 As New Point(150, 150)
Dim brR As New SolidBrush(Color.Red)
Dim linGradBr As New LinearGradientBrush(pt2, pt3, Color.Yellow, Color.Blue)
Dim pictBoxSize As Size
Dim sz As Size
Dim width, height As Integer
pictBoxSize = New Size(CType(PictureBox1.Size, Point))
width = CInt(pictBoxSize.Width / 2)
height = CInt(pictBoxSize.Height / 2)
sz = New Size(width, height)
n += 1
Debug.Print(String.Format("DisplayMyStuff: {0}, Half-Size = {1} / {2}", n, width, height))
g.Clear(Color.Bisque)
rect1 = New Rectangle(pt1, sz)
rect2 = New Rectangle(pt2, sz)
g.FillRectangle(brR, rect1)
g.FillRectangle(linGradBr, rect2)
brR.Dispose()
linGradBr.Dispose()
End Sub
End Class
Apparently, you are trying to draw to a picturebox (g = PictureBox1.CreateGraphics())
The reason stuff disappears is that when the size changes, or something passes over the window, the controls and form need to be repainted. This happens in the Paint event, so your code needs to do the drawing there. Unlike a PictureBox image, items drawn to a form or control are not persistent on their own, that is done by drawing in the Paint event.
This is essentially your DrawMyStuff procedure relocated to the Picbox's Paint event.
Private Sub PictureBox1_Paint(sender As Object,
e As PaintEventArgs) Handles PictureBox1.Paint
Dim pt1 As New Point(50, 50)
Dim pt2 As New Point(100, 100)
Dim pt3 As New Point(150, 150)
Dim sz As New Size(CInt(PictureBox1.Size.Width / 2),
CInt(PictureBox1.Size.Height / 2))
n += 1
Debug.Print(String.Format("DisplayMyStuff: {0},
Half-Size = {1} / {2}", n, sz.Width, sz.Height))
Dim rect1 As New Rectangle(New Point(50, 50), sz)
Dim rect2 As New Rectangle(New Point(100, 100), sz)
Using linGradBr As New LinearGradientBrush(pt2, pt3, Color.Yellow, Color.Blue)
e.Graphics.Clear(Color.Bisque)
e.Graphics.DrawRectangle(Pens.Black, rect1)
e.Graphics.DrawRectangle(Pens.Black, rect2)
e.Graphics.FillRectangle(Brushes.Red, rect1)
e.Graphics.FillRectangle(linGradBr, rect2)
End Using
End Sub
If you are actually trying to paint on the Form, then Grim's answer is the solution. There you respond to the Form Paint event. In either case, use the Graphics object provided by Windows as an EventArg.
Above, you are using the Graphics object for the PictureBox (via event args) so output is to the PictureBox.
Windows wont know you are drawing something in the Paint event, so you need to tell it that the image needs to be updated at certain times such as when the PictureBox is resized. In the resize event, add:
PictureBox1.Invalidate ' tell windows it needs to be redrawn
' or
PictureBox1.Refresh ' redraw now
Me.Refresh is a bit of overkill because the entire form likely does not need to be repainted.
As Hans Passant says. First get rid of;
Private g As Graphics
and the whole of the PictureBox1_Resize(...)... routine. Then change the following routines to be like so;
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
DisplayMyStuff(e.Graphics)
End Sub
and
Private Sub DisplayMyStuff(pGraphics As Graphics)
Dim pt1 As New Point(50, 50)
Dim pt2 As New Point(100, 100)
Dim pt3 As New Point(150, 150)
Dim pictBoxSize As New Size(CType(PictureBox1.Size, Point))
Dim width As Integer = CInt(pictBoxSize.Width / 2)
Dim height As Integer = CInt(pictBoxSize.Height / 2)
Dim sz As New Size(width, height)
pGraphics.Clear(Color.Bisque)
Dim rect1 As New Rectangle(pt1, sz)
Dim rect2 As New Rectangle(pt2, sz)
Using linGradBr As New LinearGradientBrush(pt2, pt3, Color.Yellow, Color.Blue)
pGraphics.FillRectangle(Brushes.Red, rect1)
pGraphics.FillRectangle(linGradBr, rect2)
End Using
End Sub
.. then test. Please report back to tell me that you've learned something!! Especially.. that you don't need to create a new red brush - all 'standard' colours are built in - and that using the graphics object properly leads to better, smoother displays.
Hey all i am trying to load my custom ttf font and also have it AntiAlias so it doesnt look all jagged and all.
The code in order to load the custom font is this (found here):
Dim pfc As New PrivateFontCollection()
pfc.AddFontFile("C:\Path To\PALETX3.ttf")
label1.Font = New Font(pfc.Families(0), 16, FontStyle.Regular)
The code to do the Antialias on fonts is this (found here):
Dim fontFamily As New FontFamily("Times New Roman")
Dim font As New Font( _
fontFamily, _
32, _
FontStyle.Regular, _
GraphicsUnit.Pixel)
Dim solidBrush As New SolidBrush(Color.FromArgb(255, 0, 0, 255))
Dim string1 As String = "SingleBitPerPixel"
Dim string2 As String = "AntiAlias"
e.Graphics.TextRenderingHint = TextRenderingHint.SingleBitPerPixel
e.Graphics.DrawString(string1, font, solidBrush, New PointF(10, 10))
e.Graphics.TextRenderingHint = TextRenderingHint.AntiAlias
e.Graphics.DrawString(string2, font, solidBrush, New PointF(10, 60))
However, i am not able to merge those codes above... I've tried:
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim font As New PrivateFontCollection()
font.AddFontFile("C:\Path To\PALETX3.ttf")
Dim fontFamily As New Font(font.Families(0))
Dim solidBrush As New SolidBrush(Color.FromArgb(255, 0, 0, 255))
Dim string1 As String = "SingleBitPerPixel"
Dim string2 As String = "AntiAlias"
e.Graphics.TextRenderingHint = TextRenderingHint.SingleBitPerPixel
e.Graphics.DrawString(string1, fontFamily, solidBrush, New PointF(10, 10))
e.Graphics.TextRenderingHint = TextRenderingHint.AntiAlias
e.Graphics.DrawString(string2, fontFamily, solidBrush, New PointF(10, 60))
End Sub
But an error of:
Overload resolution failed because no accessible 'New' accepts this number of arguments.
That is on the Dim fontFamily As New Font(font.Families(0)) line.
Any help to merge these 2 together would be great!
New Font has over a dozen overloads for new and you happen to pick one not in the list. The very minimum when specifying args is:
Dim myFont As New Font(familyName As String, emSize as integer)
so try this:
Dim myFont As New Font(font.Families(0), 16)
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