I am currently making a Chess game as a side project, but i'm struggling to figure out how to make the different tiles clickable. Searching only yielded a C# answer which didn't work.
I've used the creategraphics command to draw on my form, if that's of any help.
Sub DrawBoard()
Dim Board As Graphics = Me.CreateGraphics
Dim BlackPen As New Pen(Color.Black, 3)
Board.Clear(Color.White)
For i = 0 To 3
For j = 0 To 6 Step 2
Board.FillRectangle(Brushes.Gray, j * 60, 120 * i, 60, 60)
Next
For j = 1 To 7 Step 2
Board.FillRectangle(Brushes.Gray, j * 60, (120 * i) + 60, 60, 60)
Next
Next
For i = 0 To 7
For f = 0 To 7
Board.DrawRectangle(BlackPen, i * 60, (f * 60), 60, 60)
Next
Next
BlackPen.Dispose()
End Sub
This is the code I'm using to draw the chess board at the moment.
Related
I'm making a custom winforms button in VB.Net with rounded edges and other features. I create a path using various inputs defined by the user and draw and fill it using pens and brushes.
When I call e.Graphics.FillEllipse(Brush1, Rect1) and e.Graphics.DrawEllips(Pen1, Rect1) it just works fine without any problems, but when I try e.Graphics.FillPath(Brush1, OuterPath) and e.Graphics.DrawPath(Pen1, OuterPath) it doesn't work at all. I get this error:
ArgumentException: The parameter is not valid
I tried giving the right types of each variable used in the process and not letting the compiler decide, creating more variables to calculate and manage the inputs individually to not make all the calculations in the inputs of each function, which makes my work easier honestly, and even using the CType function in the inputs of each function to make sure that the function understands what I want as inputs. But everything failed and I don't know what to do next to fix the issue.
Here is the code:
Private Sub MetaniumButton_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim PathWidth As Integer = Width - BorderSize / 2
Dim PathHeight As Integer = Height - BorderSize / 2
_Roundnes = RoundnesMemory
If PathHeight < Roundenes.Height Then
_Roundnes.Height = PathHeight - 1
End If
If PathWidth < Roundenes.Width Then
_Roundnes.Width = PathWidth - 1
End If
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Dim OuterPath As New GraphicsPath
Dim Rec1 As Rectangle = New Rectangle(CType(BorderSize / 2, Int32), CType(BorderSize / 2, Int32), CType(_Roundnes.Width, Int32), CType(_Roundnes.Height, Int32))
Dim Rec2 As Rectangle = New Rectangle(PathWidth - _Roundnes.Width, BorderSize / 2, _Roundnes.Width, _Roundnes.Height)
Dim Rec3 As Rectangle = New Rectangle(PathWidth - _Roundnes.Width, PathHeight - _Roundnes.Height, _Roundnes.Width, _Roundnes.Height)
Dim Rec4 As Rectangle = New Rectangle(BorderSize / 2, PathHeight - _Roundnes.Height, _Roundnes.Width, _Roundnes.Height)
OuterPath.StartFigure()
OuterPath.AddLine(CInt(_Roundnes.Width / 2 + BorderSize / 2), CInt(BorderSize / 2), CInt(PathWidth - _Roundnes.Width / 2), CInt(BorderSize / 2))
OuterPath.AddArc(Rec1, 180.0, 90.0) ' Here is the problem and it could probably in any AddArc Function i used
OuterPath.AddLine(PathWidth, CInt(_Roundnes.Height / 2 + BorderSize / 2), PathWidth, CInt(PathHeight - _Roundnes.Height / 2))
OuterPath.AddArc(Rec2, -90, 90)
OuterPath.AddLine(CInt(_Roundnes.Width / 2 + BorderSize / 2), PathHeight, CInt(PathWidth - _Roundnes.Width / 2), PathHeight)
OuterPath.AddArc(Rec3, 0, 90)
OuterPath.AddLine(CInt(BorderSize / 2), CInt(_Roundnes.Height / 2), CInt(BorderSize / 2), CInt(PathHeight - _Roundnes.Height / 2))
OuterPath.AddArc(Rec4, 90, 90)
OuterPath.CloseFigure()
e.Graphics.FillPath(Brush1, OuterPath)
e.Graphics.DrawPath(Pen1, OuterPath)
Dim LabelCount As Integer = 0
For Each l As Label In Controls
LabelCount += 1
Next
Dim TextPlace As New Label With {.Name = "TextLabel",
.Text = Text,
.AutoEllipsis = True,
.Size = New Size(Width -
Margin.Left + Margin.Right + 2 * _Roundnes.Width) / 2, Height - (Margin.Top + Margin.Bottom + 2 * _Roundnes.Height) / 2),
.TextAlign = _TextAlign,
.ForeColor = _FontColor,
.BackColor = _MetaniumBackColor,
.Location = New Point((Width - .Width) / 2, (Height - .Height) / 2)}
AddHandler TextPlace.TextChanged, AddressOf MetaniumButton_TextChanged
AddHandler Me.TextChanged, AddressOf MetaniumButton_TextChanged
Controls.Add(TextPlace)
T += 1
If LabelCount <= 0 Then
0: For Each l As Label In Controls
If l.Name = "TextLabel" Then
l.Text = Text
l.AutoEllipsis = True
l.Size = New Size(Width - (Margin.Left + Margin.Right + 2 * _Roundnes.Width) / 2, Height - (Margin.Top + Margin.Bottom + 2 * _Roundnes.Height) / 2)
l.TextAlign = _TextAlign
l.ForeColor = _FontColor
l.BackColor = _MetaniumBackColor
l.Location = New Point((Width - l.Width) / 2, (Height - l.Height) / 2)
End If
Next
ElseIf LabelCount = 1 Then
For Each l As Label In Controls
If l.Name <> "TextLabel" Then
Controls.Remove(l)
Else
GoTo 1
End If
1: GoTo 0
Next
Else
End If
End Sub
When I track down the bug it seems the problem is in the AddArc() function, and I really don't know why it doesn't work. Any help appreciated.
BTW, I use VB.Net Express 2010 with .Net Framework 4.8.
PS: you can post an answer using either VB.Net or C# I can translate the code from both of them.
I solved My problem, and the answer was to initialize the value or Roundnes to (1,1) at least because my code creates the arcs of the edges using Roundnes to know how wide and long the curving edge
so the solution is to add this line of code before the code responsible for creating the arc.
If _Roundnes = New Size(0, 0) Then _Roundnes = New Size(1, 1)
And that's pretty much it! Thank you for helping me out!
I want to draw a line chart in vb.net 2013, something like shown in the picture:
I managed to draw a tangent but I am unable to draw the parallel lines.
Not exactly sure if this what you need, but you only need to construct new points at (0.1, 0) and (0.2, 0) and use slope factor of tangent line to get points where you need to draw parallel lines.
Dim A = New Point(120, 80)
Dim k As Double = 0.5
Dim kx = 1.0
Dim ky = kx * k
Dim A1 = New Point(A.X + kx * 30, A.Y - ky * 30)
' Line at 0.1
Dim B = New Point(110, 100)
Dim B1 = New Point(B.X + kx * 30, B.Y - ky * 30)
' Line at 0.2
Dim C = New Point(120, 100)
Dim C1 = New Point(C.X + kx * 30, C.Y - ky * 30)
Image of the problem
Sub DrawGraph()
'Used to draw the current state.
G = Me.CreateGraphics
'G.Clear(Color.White) 'Sets entire background to white
G.clear(transparent)
Dim placeholder As Integer = 0 'Used to store the current point being checked.
If UsedLocations > 0 Then 'This part will only run if any points have been made
For i = 0 To 19
If Locations(i).Name <> "unused" Then 'only draws points that aren't unused.
If Locations(i).StartPoint = True Then 'only draws light blue outline if the point is selected as the start.
'the -3 on the end is to correct positions.
G.FillEllipse(Brushes.LightBlue, Locations(i).Xcoord - 3, Locations(i).Ycoord - 3, 16, 16)
End If
If Locations(i).Selected = True Then 'only draws the light green outline if the point is currently selected.
G.FillEllipse(Brushes.LightGreen, Locations(i).Xcoord - 3, Locations(i).Ycoord - 3, 16, 16)
End If
G.FillEllipse(Brushes.Black, Locations(i).Xcoord, Locations(i).Ycoord, 10, 10)
End If
Next
For i = 0 To UsedConnections - 1
'draws connections
If Connections(i).PartOfSolution = True Then
G.DrawLine(Pens.Red, Locations(Connections(i).PointOne).Xcoord + 5, Locations(Connections(i).PointOne).Ycoord + 5, Locations(Connections(i).PointTwo).Xcoord + 5, Locations(Connections(i).PointTwo).Ycoord + 5)
Else
G.DrawLine(Pens.Black, Locations(Connections(i).PointOne).Xcoord + 5, Locations(Connections(i).PointOne).Ycoord + 5, Locations(Connections(i).PointTwo).Xcoord + 5, Locations(Connections(i).PointTwo).Ycoord + 5)
End If
Next
'creating labels
Controls.Clear()
Dim NumberToMake As Integer = (39 + UsedConnections)
Dim infolabels(NumberToMake) As Label
For i = 0 To NumberToMake
infolabels(i) = New Label
infolabels(i).Height = 13
infolabels(i).BackColor = Color.Red
If i < 20 Then
infolabels(i).Text = Locations(i).Name
infolabels(i).Top = Locations(i).Ycoord - 15
infolabels(i).Left = Locations(i).Xcoord
If Locations(i).Name <> "unused" Then
Me.Controls.Add(infolabels(i))
End If
ElseIf i > 19 And i < 40 Then
'dijkstra labels
Else
Console.WriteLine(i)
Console.WriteLine(Connections(i - 40).Length)
infolabels(i).Text = CStr(Connections(i - 40).Length)
infolabels(i).Top = 0
infolabels(i).Top = (Locations(Connections(i - 40).PointOne).Ycoord + Locations(Connections(i - 40).PointTwo).Ycoord) * 0.5
'infolabels(i).Left = (Locations(Connections(i - 40).PointOne).Xcoord + Locations(Connections(i - 40).PointTwo).Xcoord) * 0.5
Me.Controls.Add(infolabels(i))
End If
infolabels(i).Width = infolabels(i).Text.Length * 15
Next
End If
End Sub
So while trying to add labels to a form to display information above points & connections, i found that they were covering them. I've already set width & height to proper conenctions, without changing anything.
I've tried setting the backcolour to red to find the problem, that did nothing.
After playing with the background colour of the form, I've found that the label has some white part added on to the sides (as pictured above), and i can't find any way to control it so that it doesn't cover up the draw objects.
Thanks in advance for help.
Edit: after investigating a little more, it seems the white space is the space the labels would normally take up before i resize them.
I had to resize the labels before adding controls to the form, like so:
If i < 20 Then
infolabels(i).Text = Locations(i).Name
infolabels(i).Top = Locations(i).Ycoord - 15
infolabels(i).Left = Locations(i).Xcoord
If Locations(i).Name <> "unused" Then
infolabels(i).Width = infolabels(i).Text.Length * 10
Me.Controls.Add(infolabels(i))
End If
ElseIf i > 19 And i < 40 Then
'dijkstra labels
Else
Console.WriteLine(i)
Console.WriteLine(Connections(i - 40).Length)
infolabels(i).Text = CStr(Connections(i - 40).Length)
'infolabels(i).Top = 0
infolabels(i).Top = (Locations(Connections(i - 40).PointOne).Ycoord + Locations(Connections(i - 40).PointTwo).Ycoord) * 0.5
infolabels(i).Left = (Locations(Connections(i - 40).PointOne).Xcoord + Locations(Connections(i - 40).PointTwo).Xcoord) * 0.5
infolabels(i).Width = infolabels(i).Text.Length * 10
Me.Controls.Add(infolabels(i))
End If
Using excel visual basic, I want to select multiple figures and group them, repeatedly.
My code goes like this:
circleCnt = 5
For j = 1 To circleCnt
ActiveSheet.Shapes.AddShape(msoShapeOval, 500, 30, 40, 30).Select
Selection.ShapeRange.Height = minWidth + circleWidth * (circleCnt - j + 1)
Selection.ShapeRange.Width = minWidth + circleWidth * (circleCnt - j + 1)
Selection.ShapeRange.IncrementLeft circleWidth / 2 * (j - 1) + circleWidth / 2
Selection.ShapeRange.IncrementTop circleWidth / 2 * (j - 1) + circleWidth / 2
Next j
Yep, it's drawing multiple circles and I'm trying to present my data with these codes. The problem is... my full data makes more than a hundred group of circles and it takes forever to transfer all the circles into the powerpoint
I want to make circles from a sample into a group - and how can I select multiple shape objects? I was thinking like
for n = 1 to 5
select shape #n
next n
but as you can see, this didn't work
Is there any 'cumulative' code for selection? or selecting last object and make them into a group of previously grouped objects?
-I don't want to make 'all circles' into one group - a group for a sample, with multiple samples :)
After you add the shapes, you need to iterate over all the shapes on the sheet and store the shape names in an array. Using that, you can create a ShapeRange object and Group the shapes. Here is a code sample:
Sub GroupAllShapes()
Dim arrShapeNames() As Variant 'must be Variant to work with Shapes.Range()
Dim shp As Shape
Dim sr As ShapeRange
Dim ws As Worksheet
Dim i As Integer
Set ws = ActiveSheet
ReDim arrShapeNames(ws.Shapes.Count - 1)
i = 0
For Each shp In ws.Shapes
arrShapeNames(i) = shp.Name
i = i + 1
Next
Set sr = ws.Shapes.Range(arrShapeNames)
sr.Group
Set sr = Nothing
Set ws = Nothing
End Sub
Note: I ported this from some of my C# code and have the arrShapeNames array with a zero-based index. You may need to make it 1-based for VBA.
Try to avoid selecting anything in your code. This makes your code really slow. It's not entirely clear for me what you're trying to do, but try something like this:
dim objShape as Shape
for j = 1 To circleCnt
set objShape = Shapes.AddShape(msoShapeOval, 500, 30, 40, 30)
With objShape
.ShapeRange.Height = minWidth + circleWidth * (circleCnt - j + 1)
.ShapeRange.Width = minWidth + circleWidth * (circleCnt - j + 1)
.ShapeRange.IncrementLeft circleWidth / 2 * (j - 1) + circleWidth / 2
.ShapeRange.IncrementTop circleWidth / 2 * (j - 1) + circleWidth / 2
End With
next
set objShape = Nothing
I want to draw to my form using e.Graphics. So I've drawn a set of rectangles (for the chess tiles for the game I'm making) and now I want to draw the pieces on top of the already drawn (and working) rectangles. The chess pieces are transparent png's saved in my Resources folder. I have no problem drawing them normally, but whenever I want to draw them on top of the tiles, only the tiles are visible - regardless of which line of code goes first. How do I add the pieces on top of the tiles, so the tiles are underneath?
This is the problematic code:
If Not alreadydrawn Then
Dim g As Graphics = Graphics.FromImage(screenbuffer)
Checked = False
For y = 1 To 8
For x = 1 To 8
If Checked Then g.FillRectangle(Brushes.LightGray, (x * 85) - 40, (y * 85) - 40, 85, 85)
If Not Checked Then g.FillRectangle(Brushes.Black, (x * 85) - 40, (y * 85) - 40, 85, 85)
Checked = Not Checked
Next
Checked = Not Checked
Next
e.Graphics.DrawImage(My.Resources.Bishop_White, New Rectangle(New Point(50, 50), New Size(64, 64)))
alreadydrawn = True
End If
e.Graphics.DrawImageUnscaledAndClipped(screenbuffer, New Rectangle(New Point(0, 0), New Size(795, 805)))
This is the solution I made:
checked = False
For y = 1 To 8
For x = 1 To 8
If clickedsquare(0) = x - 1 And clickedsquare(1) = y - 1 And Not boardlayout(y - 1, x - 1) = 0 And clickmode = "options" Then
t.FillRectangle(New SolidBrush(Color.FromArgb(225, 212, 128)), x * 75, y * 75, 75, 75)
Else
If checked Then t.FillRectangle(New SolidBrush(Color.FromArgb(64, 64, 64)), x * 75, y * 75, 75, 75)
If Not checked Then t.FillRectangle(New SolidBrush(Color.FromArgb(224, 224, 224)), x * 75, y * 75, 75, 75)
End If
checked = Not checked
Next
checked = Not checked
Next
...
Then:
tiles.Image = tilebuffer
pieces.Image = piecebuffer
BackgroundImage = tiles.Image
pieces.BackColor = Color.Transparent
alreadydrawn = True