Hey all i have the following code that works just fine when my form loads up:
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim custFont As New PrivateFontCollection()
Dim solidBrush As New SolidBrush(Color.FromArgb(255, 0, 0, 255))
Dim string2 As String = "AntiAlias"
custFont.AddFontFile("C:\aFont.ttf")
e.Graphics.TextRenderingHint = TextRenderingHint.AntiAlias
e.Graphics.DrawString(string2, New Font(custFont.Families(0), 100, FontStyle.Regular, GraphicsUnit.Pixel), solidBrush, New PointF(10, 60))
End Sub
However, i need a way to update that font text whenever i push a button(s) on the form itself. I tried making a sub like so:
Public Sub changeText(ByVal e As System.Windows.Forms.PaintEventArgs, ByVal theText as string)
Dim custFont As New PrivateFontCollection()
Dim solidBrush As New SolidBrush(Color.FromArgb(255, 0, 0, 255))
custFont.AddFontFile("C:\aFont.ttf")
e.Graphics.TextRenderingHint = TextRenderingHint.AntiAlias
e.Graphics.DrawString(theText, New Font(custFont.Families(0), 100, FontStyle.Regular, GraphicsUnit.Pixel), solidBrush, New PointF(10, 60))
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
changeText(Me.OnPaint, "just a test")
End Sub
But i end up having an error:
Overload resolution failed because no accessible 'OnPaint' accepts this number of arguments.
on line:
changeText(Me.OnPaint, "just a test")
Any help would be great! Thanks!
Move the string out to class level so you can change it:
Imports System.Drawing.Text
Public Class Form1
Private string2 As String = "AntiAlias"
Private custFont As New PrivateFontCollection()
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
custFont.AddFontFile("C:\aFont.ttf")
End Sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Using solidBrush As New SolidBrush(Color.FromArgb(255, 0, 0, 255))
Using fnt As New Font(custFont.Families(0), 100, FontStyle.Regular, GraphicsUnit.Pixel)
e.Graphics.TextRenderingHint = TextRenderingHint.AntiAlias
e.Graphics.DrawString(string2, fnt, solidBrush, New PointF(10, 60))
End Using
End Using
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
string2 = "just a test"
Me.Refresh()
End Sub
End Class
Related
The following code example paints three rectangles and changes the cursor type to hand/default if the mouse is inside/outside the rectangular regions respectively. The program executes as intended with one exception: when located inside a region, the mouse flickers while being moved.
Having investigated, it seems the issue may relate to a contradiction between my code and an underlying control, with respect to which mouse type to display, resulting in flicker. Whether correct or not, unfortunately I've been unable to resolve the issue. Please can you help?
Imports System.Drawing.Drawing2D
Public Class Form1
Private myRectangles() As Rectangle
Private myRegions(2) As Region
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' Write an array of rectangles.
myRectangles = {New Rectangle(100, 100, 50, 50), New Rectangle(200, 200, 50, 50), New Rectangle(300, 300, 50, 50)}
' Write an array of rectangle regions.
For i As Integer = 0 To myRegions.length - 1
Dim myPath As New GraphicsPath
myPath.AddRectangle(myRectangles(i))
Dim myRegion As New Region(myPath)
myRegions(i) = myRegion
Next
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
' Iterate myRegions to check if the mouse is over a region.
For i As Integer = 0 To myRegions.Count - 1
Dim IsHit As Boolean = myRegions(i).IsVisible(e.Location)
If IsHit Then
Cursor.Current = Cursors.Hand
Exit For
Else
Cursor.Current = Cursors.Default
End If
Next
End Sub
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
' Paint myRectangles.
For i As Integer = 0 To myRegions.Length - 1
e.Graphics.DrawRectangle(New Pen(Color.Black, 1), myRectangles(i))
Next
End Sub
End Class
EDIT1: The above MouseMove Sub can be simplified to the following:
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
' Check if the mouse is located within any region.
Dim isHit As Boolean = myRegions.Any(Function(p) p.IsVisible(e.Location))
If isHit Then
Cursor.Current = Cursors.Hand
Else
Cursor.Current = Cursors.Default
End If
End Sub
EDIT2: Revised complete code:
Imports System.Drawing.Drawing2D
Public Class Form1
Private myRectangles() As Rectangle
Private myGraphicsPaths As New List(Of GraphicsPath)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' Write a graphics path list of rectangles.
myRectangles = {New Rectangle(100, 100, 50, 50), New Rectangle(200, 200, 50, 50), New Rectangle(300, 300, 50, 50)}
For i As Integer = 0 To myRectangles.Length - 1
Dim myPath As New GraphicsPath
myPath.AddRectangle(myRectangles(i))
myGraphicsPaths.Add(myPath)
Next
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
' Check if the mouse is located within any graphicspath.
Dim isHit As Boolean = myGraphicsPaths.Any(Function(p) p.IsVisible(e.Location))
If isHit And Cursor.Current IsNot Cursors.Hand Then
Cursor.Current = Cursors.Hand
Else
Cursor.Current = Cursors.Default
End If
End Sub
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
' Paint myRectangles.
For i As Integer = 0 To myRectangles.Length - 1
e.Graphics.DrawRectangle(New Pen(Color.Black, 1), myRectangles(i))
Next
End Sub
End Class
I have a User Control that is Dynamically created. It has to raise a Mouse_Move event & Mouse_Down event.
How to manage events for Multiple User Control that are created dynamically. I was considering using a list of user controls to track the controls. But I do not know how to setup the events properly.
Public Class UserControl1
Public Structure Porportions
Dim width_Percent As Double
Dim Height_percent As Double
Dim X_Location_Percent As Double
Dim Y_Location_Percent As Double
End Structure
Dim Pipe As Porportions
Dim guage1 As Porportions
Dim guage2 As Porportions
Public start_pos As Point
Public move_offset As Point
Public Client_Point As Point
Public Pipe_Source As Excel
Public Pipe_Data As DataSet
Public Pipe_Properties As Pipe
Private Pipe_ID As String
' Public Event Pipe_MouseMove(ByVal sender As Object, ByVal e As System.EventArgs)
Public Event Pipe_MouseMove1(ByVal sender As Object, ByVal e As System.EventArgs)
Public Event Pipe_MouseDown1(ByVal sender As Object, ByVal e As System.EventArgs)
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
RaiseEvent Pipe_MouseMove1(sender, e)
End Sub
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
RaiseEvent Pipe_MouseDown1(sender, e)
End Sub
Public Class Form1
Private pipe_cnt As Integer = 0
Private start_position As Point
Private MoveOffset As Point
Private Mouse_Position As Point
Private WithEvents pp As UserControl1
Private Sub Pipe_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles pp.Pipe_MouseMove1
Dim dx As Integer
Dim dy As Integer
Dim m_loc As Point
Dim scrn As Point
m_loc = New Point(e.Location)
Mouse_Position = New Point(e.X, e.Y)
scrn = PointToScreen(Mouse_Position)
Mouse_Position = PointToClient(Mouse_Position)
dx = start_position.X - Mouse_Position.X
dy = start_position.Y - Mouse_Position.Y
MoveOffset = New Point(dx, dy)
If e.Button = MouseButtons.Left Then
Try
pp.Location = New Point(pp.Left + e.X, pp.Top + e.Y)
pp.Location = New Point(pp.Left + e.X, pp.Top + e.Y)
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End If
End Sub
Private Sub Pipe_MouseDown1(ByVal sender As Object, ByVal e As System.EventArgs) Handles pp.Pipe_MouseDown1
start_position = New Point(pp.Location)
End Sub
What I understand that you want to use an same event for multiple user controls. There are many methods to achieve this.
Method 1 (Easiest):
Just put handler events after Handles clause and separate them by commas ,. See example:
Private Sub MouseMove_Event(sender As Object, e As MouseEventArgs) Handles Pipe.MouseMove, PictureBox1.MouseMove
MsgBox("MouseMove")
End Sub
Private Sub Click_Event(sender As Object, e As MouseEventArgs) Handles Pipe.Click, PictureBox1.Click
MsgBox("Click")
End Sub
Private Sub MouseDown_Event(sender As Object, e As MouseEventArgs) Handles Pipe.MouseDown, PictureBox1.MouseDown
MsgBox("MouseDown")
End Sub
Method 2 (burden):
Create and collect all controls in a array of controls and then create events in a foreach loop.
Create Sub that gets array of controls and add handlers using foreach loop.
Private Sub CreateHandlers(Controls() As Control)
For Each control As Control In Controls
Me.Controls.Add(control)
AddHandler control.Click, AddressOf Click_Event
AddHandler control.MouseMove, AddressOf MouseMove_Event
AddHandler control.MouseDown, AddressOf MouseDown_Event
Next
End Sub
Your events
Private Sub Click_Event(sender As Object, e As EventArgs)
'Handle Click events here
End Sub
Private Sub MouseMove_Event(sender As Object, e As EventArgs)
'Handle MouseMove events here
End Sub
Private Sub MouseDown_Event(sender As Object, e As EventArgs)
'Handle MouseDown events here
End Sub
Create controls dynamically and just call CreateHandlers(controls) at end
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim pictureBox1 As PictureBox = New PictureBox _
With {
.Size = New Size(100, 100),
.Location = New Point(0, 0),
.BackColor = Color.Black
}
Dim panel1 As Panel = New Panel _
With {
.Size = New Size(100, 100),
.Location = New Point(100, 0),
.BackColor = Color.Red
}
Dim tableLayoutPanel1 As TableLayoutPanel = New TableLayoutPanel _
With {
.Size = New Size(100, 100),
.Location = New Point(200, 0),
.BackColor = Color.Green
}
Dim controls() As Control = {pictureBox1, panel1, tableLayoutPanel1}
CreateHandlers(controls)
End Sub
End Class
I try to remove empty spaces using with StringSplitOptions.RemoveEmptyEntries before print the text but when I run the codes "The index was outside the bounds of the array" appears on the screen as an error.
Could you please help to solve that problem?
Public Class Form2
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
OpenFileDialog1.ShowDialog()
TextBox2.Text = OpenFileDialog1.FileName
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Dim myfile As String = TextBox2.Text
Dim allines As String() = IO.File.ReadAllLines(myfile)
For Each line As String In allines
ListBox1.Items.Add(line)
Next
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim sayı As Integer = TextBox3.Text
End Sub
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
If (TextBox3.Text = "") Then
MessageBox.Show("Please enter number")
TextBox2.Text = ""
Else
If TextBox1.TextLength = TextBox3.Text Then
Dim fields() As String = ListBox1.Text.Split(";")
Dim idx As Integer = ListBox1.FindString(TextBox1.Text)
If idx <> -1 Then
ListBox1.SelectedIndex = idx
ListBox1.SelectedIndex.ToString(fields(0))
ListBox2.Items.Add(ListBox1.Text)
TextBox1.Text = ""
PrintDocument1.Print()
End If
End If
End If
End Sub
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim drawfont As New Font("arial", 16)
Dim drawbrush As New SolidBrush(Color.Black)
Dim fields() As String = ListBox1.Text.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
e.Graphics.DrawString(ListBox1.SelectedIndex.ToString(fields(0)), drawfont, drawbrush, 100, 50)
e.Graphics.DrawString(ListBox1.SelectedIndex.ToString(fields(1)), drawfont, drawbrush, 100, 70)
e.Graphics.DrawString(ListBox1.SelectedIndex.ToString(fields(2)), drawfont, drawbrush, 100, 90)
e.Graphics.DrawString(ListBox1.SelectedIndex.ToString(fields(3)), drawfont, drawbrush, 100, 110)
e.Graphics.DrawString(ListBox1.SelectedIndex.ToString(fields(4)), drawfont, drawbrush, 100, 130)
e.Graphics.DrawString(ListBox1.SelectedIndex.ToString(fields(7)), drawfont, drawbrush, 10, 20)
e.Graphics.DrawString(ListBox1.SelectedIndex.ToString(fields(10)), drawfont, drawbrush, 270, 20)
ListBox1.Items.Remove(TextBox1.Text)
End Sub
End Class
How can i use clause Handles in my class method. For example i want to draw an image on picturebox1 with code:
Public Class cell
Public Sub draw_cell() Handles picturebox1.paint
code
End Sub
End Class
I have an error:
Handles clause requires a WithEvents variable defined in the containing type or one of its base types.
How can i do this without using
Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
ps. sorry for bad english.
You can create your own routines to draw to your canvas.
Option Strict On
Option Explicit On
Option Infer Off
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim canvas As New Bitmap(PictureBox1.Width, PictureBox1.Height)
Dim canvasGraphics As Graphics = Graphics.FromImage(canvas)
Dim cellRect As New Rectangle(100, 100, 100, 100)
cell.draw(canvasGraphics, cellRect, Color.Red, New Pen(New SolidBrush(Color.Green), 1))
PictureBox1.Image = canvas
End Sub
Public Class cell
Public Shared Sub draw(ByRef canvasGraphics As Graphics, ByVal cellRect As Rectangle, ByVal fillColor As Color, ByVal borderPen As Pen)
Dim renderedCell As New Bitmap(cellRect.Width, cellRect.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
Dim borderRect As New Rectangle(0, 0, cellRect.Width - 1, cellRect.Height - 1)
Dim context As BufferedGraphicsContext
Dim bGfx As BufferedGraphics
context = BufferedGraphicsManager.Current
context.MaximumBuffer = New Size(cellRect.Width + 1, cellRect.Height + 1)
bGfx = context.Allocate(Graphics.FromImage(renderedCell), New Rectangle(0, 0, cellRect.Width, cellRect.Height))
Dim g As Graphics = bGfx.Graphics
g.Clear(fillColor)
g.DrawRectangle(borderPen, borderRect)
bGfx.Render()
canvasGraphics.DrawImage(renderedCell, cellRect.Location)
End Sub
End Class
End Class
I am using VB .NET programming and I would like to print my WinFormsApplication in landscape mode as the portrait mode could not fit it properly.
I have set the landscape mode as true. You may refer to the code below:
Private Sub PrintAll_Click(ByVal sender As Object, ByVal e As System.EventArgs)
Handles PrintAll.Click
PrintForm1.Form = Me
PrintDocument1.DefaultPageSettings.Landscape = True
PrintForm1.Print(Me, PowerPacks.Printing.PrintForm.PrintOption.FullWindow)
PrintDialog1.ShowDialog()
End Sub
And the result is shown as below in the screenshot
http://s335.photobucket.com/user/blakeex/media/notcomplete.png.html
Could anyone share some hint or guides?
to print the complete client area of a scrollable form, even if the form has been resized.
Try PrintForm1.Print(Me, PowerPacks.Printing.PrintForm.PrintOption.Scrollable)
Here's another way that will print whatever part of the form is viewable on the screen:
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
CaptureScreen()
PrintDocument1.DefaultPageSettings.Landscape = True
PrintDocument1.DefaultPageSettings.Margins = New Printing.Margins(0, 0, 0, 0)
PrintDocument1.Print()
End Sub
Dim memoryImage As Bitmap
Private Sub CaptureScreen()
Dim myGraphics As Graphics = Me.CreateGraphics()
Dim s As Size = Me.Size
memoryImage = New Bitmap(s.Width, s.Height, myGraphics)
Dim memoryGraphics As Graphics = Graphics.FromImage(memoryImage)
memoryGraphics.CopyFromScreen(Me.Location.X, Me.Location.Y, 0, 0, s)
End Sub
Private Sub printDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim pagerec As New RectangleF(e.PageSettings.PrintableArea.X, e.PageSettings.PrintableArea.Y, e.PageSettings.PrintableArea.Height, e.PageSettings.PrintableArea.Width)
e.Graphics.DrawImage(memoryImage, pagerec, New Rectangle(Me.Location, Me.Size), GraphicsUnit.Pixel)
End Sub