Render multiple Image Layers to transparent PNG image - vb.net

Not exactly sure how to word this question, so I will go on to explain the details, and try to ask as best I can form it.
I have a project which consists of the following components
Canvas - Inherits PictureBox control
Layers - A collection of "Layer"
Layer - Can contain a collection of Graphics as Images with information.
Each layer can be moved and the selection box for the layer is constrained to the portion of the layer which contains graphics at maximum bounds.
All of the above is working !!
What is not working, is when I want to save the combined result (including transparency, and alpha's), the Canvas control is empty. I know the images are being drawn in the box as it does not display anything until i do Canvas1.Invalidate() .
The code I have for the classes are as follows :
Canvas
Imports System.Drawing
Imports System.Drawing.Graphics
Public Class Canvas
Inherits PictureBox
Private _MoveStart As Point
Private _Layers As List(Of Layer)
Public Sub New()
Me.DoubleBuffered = True
_Layers = New List(Of Layer)
End Sub
Public ReadOnly Property Layers() As List(Of Layer)
Get
Return _Layers
End Get
End Property
Public Property SelectedLayer As Layer
Get
'Loop through all layers and return the one that is selected
For Each l As Layer In Me.Layers
If l.Selected Then Return l
Next
Return Nothing
End Get
Set(ByVal value As Layer)
'Loop through all layers and set their Selected property to True if it is the assigned layer ("value") or False if it isn't.
For Each l As Layer In Me.Layers
l.Selected = (l Is value)
Next
End Set
End Property
Private Function GetLayerFromPoint(ByVal p As Point) As Layer
' Finds the layer that contains the point p
For Each l As Layer In Me.Layers
If l.Bounds.Contains(p) Then Return l
Next
Return Nothing
End Function
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseDown(e)
If e.Button = Windows.Forms.MouseButtons.Left Then
' Store the previous selected layer to refresh the image there
Dim oldSelection = Me.SelectedLayer
' Get the new selected layer
Me.SelectedLayer = Me.GetLayerFromPoint(e.Location)
'Update the picturebox
If oldSelection IsNot Nothing Then Me.InvalidateLayer(oldSelection)
Me.InvalidateLayer(Me.SelectedLayer)
Me.Update()
_MoveStart = e.Location
End If
End Sub
Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseMove(e)
If Control.MouseButtons = Windows.Forms.MouseButtons.Left Then
If Me.SelectedLayer IsNot Nothing Then
'Store the old bounds for refreshing
Dim oldBounds As Rectangle = Me.SelectedLayer.Bounds
'Move the selected layer
Me.SelectedLayer.Move(e.Location.X - _MoveStart.X, e.Location.Y - _MoveStart.Y)
_MoveStart = e.Location
'Update the picturebox
Me.InvalidateRectangle(oldBounds)
Me.InvalidateLayer(Me.SelectedLayer)
Me.Update()
End If
End If
End Sub
Private Sub InvalidateLayer(ByVal l As Layer)
If l IsNot Nothing Then
Me.InvalidateRectangle(l.Bounds)
End If
End Sub
Private Sub InvalidateRectangle(ByVal r As Rectangle)
'Inflate by 1 pixel otherwise the border isnt visible
r.Inflate(1, 1)
Me.Invalidate(r)
End Sub
Protected Overrides Sub OnPaint(ByVal pe As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaint(pe)
For Each l As Layer In Me.Layers
l.Draw(pe.Graphics)
Next
End Sub
End Class
Layer
Imports System.Drawing
Imports System.Drawing.Graphics
Public Class Layer
Private _Graphics As List(Of Graphic)
Private _Name As String
Private _Selected As Boolean
Public Sub New(ByVal name As String)
Me.Name = name
Me.Selected = False
Me.Graphics = New List(Of Graphic)
End Sub
Public Property Name() As String
Get
Return _Name
End Get
Set(ByVal value As String)
_Name = value
End Set
End Property
Public Property Selected() As Boolean
Get
Return _Selected
End Get
Set(ByVal value As Boolean)
_Selected = value
End Set
End Property
Public ReadOnly Property Bounds As Rectangle
Get
'Combine the bounds of all items
If Me.Graphics.Count > 0 Then
Dim b = Me.Graphics(0).Bounds
For i As Integer = 1 To Me.Graphics.Count - 1
b = Rectangle.Union(b, Me.Graphics(i).Bounds)
Next
Return b
End If
Return Rectangle.Empty
End Get
End Property
Public Property Graphics() As List(Of Graphic)
Get
Return _Graphics
End Get
Set(ByVal value As List(Of Graphic))
_Graphics = value
End Set
End Property
Public Sub Move(ByVal dx As Integer, ByVal dy As Integer)
'Simply move each item
For Each item As Graphic In Me.Graphics
item.Move(dx, dy)
Next
End Sub
Public Sub Draw(ByVal g As System.Drawing.Graphics)
'Draw each item
For Each item As Graphic In Me.Graphics
item.Draw(g)
Next
'Draw a selection border if selected
If Me.Selected Then
g.DrawRectangle(Pens.Red, Me.Bounds)
End If
End Sub
End Class
Graphic
Public Class Graphic
Private _Image As Image
Private _Location As Point
Private _Size As Size
Public Sub New(ByVal img As Image)
Me.Bounds = Rectangle.Empty
Me.Image = img
End Sub
Public Sub New(ByVal img As Image, ByVal location As Point)
Me.New(img)
Me.Location = location
Me.Size = img.Size
End Sub
Public Sub New(ByVal img As Image, ByVal location As Point, ByVal size As Size)
Me.New(img)
Me.Location = location
Me.Size = size
End Sub
Public Property Location() As Point
Get
Return _Location
End Get
Set(ByVal value As Point)
_Location = value
End Set
End Property
Public Property Size() As Size
Get
Return _Size
End Get
Set(ByVal value As Size)
_Size = value
End Set
End Property
Public Property Bounds() As Rectangle
Get
Return New Rectangle(Me.Location, Me.Size)
End Get
Set(ByVal value As Rectangle)
Me.Location = value.Location
Me.Size = value.Size
End Set
End Property
Public Property Image() As Image
Get
Return _Image
End Get
Set(ByVal value As Image)
_Image = value
End Set
End Property
Public Sub Move(ByVal dx As Integer, ByVal dy As Integer)
' We need to store a copy of the Location, change that, and save it back,
' because a Point is a structure and thus a value-type!!
Dim l = Me.Location
l.Offset(dx, dy)
Me.Location = l
End Sub
Public Sub Draw(ByVal g As Graphics)
If Me.Image IsNot Nothing Then
g.DrawImage(Me.Image, Me.Bounds)
End If
End Sub
End Class
Example Usage
Create a new WinForms project (Form1)
Add a Canvas object to the form (will be named Canvas1)
Add a Button object to the form (will be named Button1)
Paste the following code into the Form1 source view
Form1
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.DoubleBuffered = True
Me.Show()
Dim l As Layer
l = New Layer("Layer 1")
l.Graphics.Add(New Graphic(My.Resources.ActualSizeHS, New Point(10, 10)))
Canvas1.Layers.Add(l)
l = New Layer("Layer 2")
l.Graphics.Add(New Graphic(My.Resources.AlignObjectsRightHS, New Point(320, 240)))
l.Graphics.Add(New Graphic(My.Resources.AlignToGridHS, New Point(290, 140)))
l.Graphics.Add(New Graphic(My.Resources.AlignObjectsBottomHS, New Point(320, 130)))
Canvas1.Layers.Add(l)
l = New Layer("Layer 3")
l.Graphics.Add(New Graphic(My.Resources.AlignObjectsTopHS, New Point(520, 240)))
l.Graphics.Add(New Graphic(My.Resources.AlignTableCellMiddleRightHS, New Point(390, 240)))
l.Graphics.Add(New Graphic(My.Resources.AlignTableCellMiddleCenterHS, New Point(520, 130)))
Canvas1.Layers.Add(l)
Canvas1.Invalidate()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Canvas1.Image.Save("MyRenderedPicture.png", System.Drawing.Imaging.ImageFormat.Png)
End Sub
End Class
In the above example for Form1, replace My.Resources.* with wherever your graphics are located. This parameter is simply a System.Drawing.Image object.
The problem I am having, is when I click Button1 to save the image, the output does not contain any of the graphics that were added to the control. Please note that all of the graphics I am working with are PNG with fully transparent backgrounds, and dragging them around inside the container doesn't have the blocky effect of layering images using pictureboxes. Each image is true transparent. I wish to keep this level of transparency (and alpha blends if any exist), when i save the file -- but first ... i need to be able to save something other than a blank picturebox which clearly contains images.
Thanks in advance.
(image example of save where "shadows" are not rendering their opacity levels properly)
Now, if I do the following :
Dim x As Integer = 0
Using bmp As Bitmap = New Bitmap(Me.Width, Me.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
'Me.DrawToBitmap(bmp, New Rectangle(0, 0, bmp.Width, bmp.Height))
For Each l As Layer In Me.Layers
For Each g As Graphic In l.Graphics
g.Image.Save("layer" & x & ".png")
x = x + 1
Next
Next
bmp.MakeTransparent(Me.BackColor)
bmp.Save(FileName, Format)
bmp.Dispose()
End Using
Each layer is saved out properly -- individually. So the Graphics control is working as it should, it is when I combine them (and need to keep the position, and transparency), I think this is the routine I am looking for ---
How to merge System.Drawing.Graphics objects I am going to try and create a new Graphics object and try to "draw" onto it using the other graphics objects and their positions. Every example so far using clipping rectangles which will not do as that takes a pic of the stuff behind the Graphic which then needs to be made clear, etc etc.

You do not assign an image to the picbox/canvas so Image is Nothing. After all, you are just using it as a canvas not an image holder. Since the helpers already know where they are, you just need to create a bitmap and draw the images/layers to it from the bottom up:
Public Function GetBitmap(format As System.Drawing.Imaging.ImageFormat) As Bitmap
' ToDo: add graphics settings
Dim bmp As New Bitmap(Me.Width, Me.Height)
Using g As Graphics = Graphics.FromImage(bmp)
' ToDo: draw Canvas BG / COlor to bmp to start
' for BMP, JPG / non Transparents
For n As Integer = 0 To Layers.Count - 1
Layers(n).Draw(g)
Next
End Using
Return bmp
End Function
Then on the form:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' to do - add a literal SAve
Using bmp As Bitmap = Canvas1.GetBitmap(Imaging.ImageFormat.Png)
bmp.Save("C:\Temp\myImage.png", System.Drawing.Imaging.ImageFormat.Png)
End Using
End Sub

Are the PNGs ever being added to the Image of the Canvas? This isn't completely the same, so I apologize, but I recently made just a quick test app where I was trying to stack PNGs so thought I'd share what I did.
This loops through lstImages (which is actually a list of strings), loads the image into bmpTemp, and draws the image onto bmpBmp. That image is then used in the Image property of a PictureBox and added to the Controls collection of the form.
I just added another button to test saving and it worked fine with what I have below (after adding a name to the PictureBox).
Private Sub StackImages()
Dim bmpBmp As New Bitmap(picStack.Width, picStack.Height)
Dim graGraphic As Graphics = Graphics.FromImage(bmpBmp)
For Each i As String In Me.lstImages
Dim bmpTemp As New Bitmap(i)
graGraphic.DrawImage(bmpTemp, 0, 0)
Next
Dim picTemp As New PictureBox
picTemp.Top = picStack.Top
picTemp.Left = picStack.Left
picTemp.Width = picStack.Width
picTemp.Height = picStack.Height
picTemp.Image = bmpBmp
picTemp.Name = "NewPictureBox"
Me.Controls.Add(picTemp)
picTemp.BringToFront()
End Sub
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
Dim picNew As PictureBox = CType(Me.Controls.Item("NewPictureBox"), PictureBox)
picNew.Image.Save("c:\temp\picTest.png")
End Sub

Related

Changing 'lamp' Colour Indicator within the Graphical User Interface (Visual Studio 2019)

I would like to change the colour within a single circular indicator within a Graphical User Interface, so that it shows when an action is completed or when it fails ['two tone green/red LED']. I've looked through the inbuilt presets within the Toolbox but have been unable find anything.
I would therefore be grateful for any assistance.
I've found this code on the msdn.microsoft.com forum, which changes the colour of the centre of the 'dot' when you press the RadioButton.
Private Sub RadioButton_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles RadioButton1.Paint, RadioButton2.Paint
If DirectCast(sender, RadioButton).Checked Then
e.Graphics.FillEllipse(Brushes.Red, New RectangleF(2.5, 4.7, 7.2, 7.2))
End If
So have incorporated it into my code, its not at all elegant and there is clearly room for improvement, but it does work.
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If My.Computer.Network.Ping("192.168.0.1") Then
RadioButton1.ForeColor = Color.Green
RadioButton1.ForeColor = Color.Black
Else
RadioButton1.ForeColor = Color.Red
RadioButton1.ForeColor = Color.Black
End If
End Sub
Private Sub RadioButton_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles RadioButton1.Paint
If My.Computer.Network.Ping("192.168.0.1") Then
e.Graphics.FillEllipse(Brushes.Green, New RectangleF(2.5, 4.7, 7.2, 7.2))
Else
e.Graphics.FillEllipse(Brushes.Red, New RectangleF(2.5, 4.7, 7.2, 7.2))
End If
End Sub
Explanation: when the 'Test Network' button is pressed it sends out a network ping, and depending upon the return the Network RadioButton 'dot' changes colour to either Green or Red,
Here's ON/OFF LED control.
Add a new class to your project, name it say OnOffLed.vb, copy the code below and paste it in the new class.
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Drawing2D
Public Class OnOffLed
Inherits Panel
Public Enum LedState
[On]
Off
End Enum
Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or
ControlStyles.OptimizedDoubleBuffer Or
ControlStyles.ResizeRedraw Or
ControlStyles.UserPaint, True)
UpdateStyles()
End Sub
Private _state As LedState = LedState.Off
Public Property State As LedState
Get
Return _state
End Get
Set(value As LedState)
_state = value
Invalidate()
End Set
End Property
Private _onText As String
Public Property OnText As String
Get
Return _onText
End Get
Set(value As String)
_onText = value
Invalidate()
End Set
End Property
Private _offText As String
Public Property OffText As String
Get
Return _offText
End Get
Set(value As String)
_offText = value
Invalidate()
End Set
End Property
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim rec As New Rectangle(2, 2, Height - 5, Height - 5)
Dim recText As New Rectangle(Height + 2, 1, Width - (Height - 2), Height)
Dim G As Graphics = e.Graphics
G.SmoothingMode = SmoothingMode.AntiAlias
G.Clear(Parent.BackColor)
If _state = LedState.On Then
Dim cb As New ColorBlend With {
.Colors = {Color.Green, Color.DarkGreen, Color.Green},
.Positions = {0, 0.5, 1}
}
Using lgb As New LinearGradientBrush(rec, Color.Empty, Color.Empty, 90.0F) With {.InterpolationColors = cb}
G.FillEllipse(lgb, rec)
End Using
Else
Dim cb As New ColorBlend With {
.Colors = {Color.Red, Color.DarkRed, Color.Red},
.Positions = {0, 0.5, 1}
}
Using lgb As New LinearGradientBrush(rec, Color.Empty, Color.Empty, 90.0F) With {.InterpolationColors = cb}
G.FillEllipse(lgb, rec)
End Using
End If
G.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
Using br As New SolidBrush(ForeColor)
Using sf As New StringFormat With {.Alignment = StringAlignment.Near, .LineAlignment = StringAlignment.Center}
G.DrawString(If(_state = LedState.On, _onText, _offText), Font, br, recText, sf)
End Using
End Using
End Sub
End Class
Rebuild your project.
In the ToolBox under your project's component tab, you'll find the new control. OnOffLed. Drop it in your form as you drop any other control.
You can toggle the state through the State property, set different text if you need that for each state through the OnText and OffText properties.
Usage Example:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If My.Computer.Network.Ping("192.168.2.01") Then
OnOffLed1.State = OnOffLed.LedState.On
Else
OnOffLed1.State = OnOffLed.LedState.Off
End If
End Sub
Good luck.

Transparent image over two controls with different back colors

I am trying to place a transparent image over two adjacent controls that have different background colors.
I want the image to remain transparent, meaning the Image needs to show the backcolor of each control.
The controls are two Panels set to different background colors and the Image (PictureBox or otherwise) is placed between the two panel controls.
Public Class frmMain
Private Img1 As Image = Image.FromFile("C:\xxxx.png")
Private Sub frmMain_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
e.Graphics.DrawImage(Img1, 5, 5)
End Sub
End Class
Let's try this.
Create a new class in the Project, call it TPanel and paste in the custom Panel class you can find below, overwriting the existing definition.
Compile the Project then find the new TPanel control in the ToolBox and drop one instance inside a Form.
On the Form, not inside one of the Colored Panels, otherwise it will become child of another control and it will be confined inside its bounds.
Add an event handler to the Paint event of the TPanel and insert this code inside the handler method:
Private Sub TPanel1_Paint(sender As Object, e As PaintEventArgs) Handles TPanel1.Paint
Dim canvas As Control = DirectCast(sender, Control)
Dim rect As Rectangle = ScaleImageFrame(imgBasketBall, canvas.ClientRectangle)
e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
e.Graphics.CompositingMode = CompositingMode.SourceOver
e.Graphics.PixelOffsetMode = PixelOffsetMode.Half
e.Graphics.DrawImage(imgBasketBall, rect)
End Sub
Private Function ScaleImageFrame(sourceImage As Bitmap, destinationFrame As Rectangle) As Rectangle
Dim rect As RectangleF = New RectangleF(0, 0, sourceImage.Width, sourceImage.Height)
'Define the ratio between the Image Rectangle and the Container ClientRectangle
Dim ratio As Single = CType(Math.Max(destinationFrame.Width, destinationFrame.Height) /
Math.Max(rect.Width, rect.Height), Single)
rect.Size = New SizeF(rect.Width * ratio, rect.Height * ratio)
'Use Integer division to avoid negative values
rect.Location = New Point((destinationFrame.Width - CInt(rect.Width)) \ 2,
(destinationFrame.Height - CInt(rect.Height)) \ 2)
Return Rectangle.Round(rect)
End Function
In the Form, create an instance of a Bitmap object that will contain the Image; also set the Location of the Panel (TPanel)
The Controls called panColored1 and panColored2 are supposed to be the names of the two existing Panels where the Image must be positioned. The sample code positions the Image in the middle of the 2 Panels, using TPanel1.Location( (...) )
Private imgBasketBall As Bitmap = Nothing
Public Sub New()
InitializeComponent()
imgBasketBall = DirectCast(Image.FromStream(New MemoryStream(File.ReadAllBytes("basketball.png"))), Bitmap)
TPanel1.Size = New Size(120, 120)
TPanel1.Location = New Point(panColored1.Left + (panColored1.Width - TPanel1.Width) \ 2,
panColored1.Top + (panColored1.Height + panColored2.Height - TPanel1.Height) \ 2)
TPanel1.BringToFront()
End Sub
Result:
Bitmap Size Bitmap Size
(1245x1242) (1178x2000)
The TPanel (Transparent Panel) class:
Imports System.ComponentModel
<DesignerCategory("Code")>
Public Class TPanel
Inherits Panel
Private Const WS_EX_TRANSPARENT As Integer = &H20
Public Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or
ControlStyles.UserPaint Or
ControlStyles.Opaque Or
ControlStyles.ResizeRedraw, True)
SetStyle(ControlStyles.OptimizedDoubleBuffer, False)
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
e.Graphics.FillRectangle(Brushes.Transparent, Me.ClientRectangle)
MyBase.OnPaint(e)
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim parameters As CreateParams = MyBase.CreateParams
parameters.ExStyle = parameters.ExStyle Or WS_EX_TRANSPARENT
Return parameters
End Get
End Property
End Class
There is also something you can also try, It may not be professional but it works. Split the images into two halves. Draw the first half on one of the panels and the second half on the other panel.
Be Sure to Import System.IO in Your project.
The code for the splitting goes like this:
Imports System.IO
...
Public Function SplitImage(ByVal imgpath As String) As Image()
Dim img As Image = Image.FromFile(imgpath)
Dim bmp As Bitmap = DirectCast(img, Bitmap)
Dim i As Integer = bmp.Height / 2
Dim image1 As Bitmap = New Bitmap(bmp.Width, i)
Dim image2 As Bitmap = New Bitmap(bmp.Width, i)
Dim yPos As Integer = 0
For x As Integer = 0 To image1.Width - 1
For y As Integer = 0 To image1.Height - 1
image1.SetPixel(x, y, bmp.GetPixel(x, y))
yPos = y
Next
Next
yPos += 1
Dim ycount As Integer = 0
For x As Integer = 0 To image2.Width - 1
For y As Integer = yPos To bmp.Height - 1
If ycount = i Then
ycount -= 1
End If
image2.SetPixel(x, ycount, bmp.GetPixel(x, y))
ycount += 1
Next
ycount = 0
Next
Dim ms As MemoryStream = New MemoryStream
Dim ms1 As MemoryStream = New MemoryStream
image1.Save(ms, Imaging.ImageFormat.Png)
image2.Save(ms1, Imaging.ImageFormat.Png)
Dim returnedImage(2) As Image
returnedImage(0) = image1
returnedImage(1) = image2
Return returnedImage
End Function
Create Two panels on your form (Panel1 and Panel2) and a Button(Button1).
Place The two panels the way you want it, set the BackgroundImageLayout property of the panels to StretchImage.
Then from your code you can call the function like this, i.e From the Button's click event:
Public Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim pic() As Image = SplitImage("C:\xxxx.png")
Panel1.BackgroundImage = pic(0)
Panel2.BackgroundImage = pic(1)
End Sub
For More Information about the Bitmap Class, Check out this link Bitmap Class

Grid I can paint on

So I am trying to create an application to ease creation of pixel arts (school project), what I've done so far is draw a grid in a panel, next step would be to allow the user to click on a cell and have it painted, but I can't manage to make it work, here's the code I have:
Private Sub drawGrid(g As Graphics, rows As Integer, columns As Integer)
Dim originPoint As Point = New Point(10, 2)
Dim size As Size = New Size(64, 64)
Dim left As Integer = originPoint.X
Dim up As Integer = originPoint.Y
Dim right As Integer = originPoint.X + (columns * size.Width)
Dim down As Integer = originPoint.Y + (rows * size.Height)
For y As Integer = up To down + 1 Step size.Height
Dim pt1 As New Point(left, y)
Dim pt2 As New Point(right, y)
g.DrawLine(Pens.Black, pt1, pt2)
Next
For x As Integer = left To right + 1 Step size.Width
Dim pt1 As New Point(x, up)
Dim pt2 As New Point(x, down)
g.DrawLine(Pens.Black, pt1, pt2)
Next
End Sub
This draws a grid with the amount of columns and rows the user wants, but I've been struggling to allow painting
What I've been thinking is: dispose this code, and create a 'pixel' class, create the amount of 'pixel' objects based on user rows and columns, and draw each one individually, then just change each 'pixel's' color
This is a Grid class that allows setting the color of its cells.
The Grid cell are referenced using a List(Of List(Of Class)).
The Cell class Object contains is a simple Rectagle property that measures the size of the cell, and a Color property, which allows to set the color of the single cell:
Friend Class GridCell
Public Property Cell() As Rectangle
Public Property CellColor() As Color
End Class
You can define:
The size of the Grid → ColoredGrid.GridSize = new Size(...)
The number of Columns and Rows → ColoredGrid.GridColumnsRows = new Size(...)
The position of the Grid inside the Canvas → ColoredGrid.GridPosition = New Point(...)
The color of the Grid → ColoredGrid.GridColor = Color.Gray
The BackGround color of the cells → ColoredGrid.CellColor = Color.FromArgb(32, 32, 32)
The color of a selected cell → ColoredGrid.SelectedCellColor = Color.OrangeRed
The Grid class holds a reference to the control which will be used as the Canvas for the grid painting. This reference is set in the class contructor.
The Grid registers the Canvas control Paint() and MouseClick() events to respond to the related actions automatically.
When a Mouse Click is detected on the Canvas surface, the MouseEventArgs e.Location property reports the coordinates where the Click occurred.
To identify the Grid Cell where this action is performed, the GetUpdateCell() method inspects the List(Of List(Of GridCell)) using a simple LINQ SelectMany() and identified the Cell rectangle that contains the Mouse Click coordinates (expressed as a Point() value).
This identification is performed simply checking whether the Cell Rectangle.Contains(Point()).
When the cell is identified, the Canvas Invalidate() method is called, specifing the area to repaint.
This area corresponds to the Cell Rectangle, so only this section is repainted when a Cell is colored, to save resources and time.
To test it, create a Panel and a Button in a Form:
Imports System.Drawing
'This Grid object in defined at Form Class scope
Public ColoredGrid As ColorGrid
'Button used to trigger the Grid painting
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If ColoredGrid IsNot Nothing Then
ColoredGrid.Dispose()
End If
ColoredGrid = New ColorGrid(Panel1)
ColoredGrid.GridSize = New Size(300, 300)
ColoredGrid.GridColumnsRows = New Size(10, 10)
ColoredGrid.GridPosition = New Point(10, 10)
ColoredGrid.GridColor = Color.White
ColoredGrid.CellColor = Color.FromArgb(32, 32, 32)
ColoredGrid.SelectedCellColor = Color.OrangeRed
ColoredGrid.BuildGrid()
End Sub
This is a visual sample that shows how it works:
This is the main Grid class.
The ColorGrid Class supports IDisposable, because it registers the described events. These must be unregistered when the Class is not used anymore. Weird things can happen if you don't.
Public Class ColorGrid
Implements IDisposable
Private Grid As List(Of List(Of GridCell))
Private CurrentGridSize As New Size(100, 100)
Private GridColRows As New Size(10, 10)
Private CellSize As New Size(10, 10)
Private MouseCell As Point = Point.Empty
Private Canvas As Control = Nothing
Private UpdateCell As Boolean = False
Private NewGrid As Boolean = False
Public Sub New(DrawingControl As Control)
If DrawingControl IsNot Nothing Then
Me.Canvas = DrawingControl
AddHandler Me.Canvas.Paint, New PaintEventHandler(AddressOf Me.ControlPaint)
AddHandler Me.Canvas.MouseClick, New MouseEventHandler(AddressOf Me.MouseHandler)
Me.GridPosition = New Point(10, 10)
Me.CellColor = Color.FromArgb(32, 32, 32)
End If
End Sub
Public Property GridPosition() As Point
Public Property CellColor() As Color
Public Property SelectedCellColor() As Color
Public Property GridColor() As Color
Public Property GridSize() As Size
Get
Return Me.CurrentGridSize
End Get
Set(value As Size)
Me.CurrentGridSize = value
SetCellSize()
End Set
End Property
Public Property GridColumnsRows() As Size
Get
Return Me.GridColRows
End Get
Set(value As Size)
Me.GridColRows = value
SetCellSize()
End Set
End Property
Private Property RefreshCell() As GridCell
Friend Class GridCell
Public Property Cell() As Rectangle
Public Property CellColor() As Color
End Class
Private Sub SetCellSize()
Me.CellSize = New Size((Me.CurrentGridSize.Width \ Me.GridColRows.Width),
(Me.CurrentGridSize.Height \ Me.GridColRows.Height))
If Me.CellSize.Width < 4 Then Me.CellSize.Width = 4
If Me.CellSize.Height < 4 Then Me.CellSize.Height = 4
End Sub
Public Sub BuildGrid()
If Me.Canvas Is Nothing Then Return
Me.Grid = New List(Of List(Of GridCell))()
For row As Integer = 0 To GridColumnsRows.Height - 1
Dim RowCells As New List(Of GridCell)()
For col As Integer = 0 To GridColumnsRows.Width - 1
RowCells.Add(New GridCell() With {
.Cell = New Rectangle(New Point(Me.GridPosition.X + (col * Me.CellSize.Width),
Me.GridPosition.Y + (row * Me.CellSize.Height)),
Me.CellSize),
.CellColor = Me.CellColor})
Next
Me.Grid.Add(RowCells)
Next
Me.NewGrid = True
Me.Canvas.Invalidate()
End Sub
Private Sub ControlPaint(o As Object, e As PaintEventArgs)
If Me.NewGrid Then
e.Graphics.Clear(Me.Canvas.BackColor)
Me.NewGrid = False
End If
Me.Grid.
SelectMany(Function(rowcells) rowcells).
Select(Function(colcell)
If Me.UpdateCell Then
Using brush As New SolidBrush(Me.RefreshCell.CellColor)
e.Graphics.FillRectangle(brush, Me.RefreshCell.Cell.X + 1, Me.RefreshCell.Cell.Y + 1,
Me.RefreshCell.Cell.Width - 1, Me.RefreshCell.Cell.Height - 1)
End Using
Me.UpdateCell = False
Return Nothing
Else
Using pen As New Pen(Me.GridColor)
e.Graphics.DrawRectangle(pen, colcell.Cell)
End Using
Using brush As New SolidBrush(colcell.CellColor)
e.Graphics.FillRectangle(brush, colcell.Cell.X + 1, colcell.Cell.Y + 1,
colcell.Cell.Width - 1, colcell.Cell.Height - 1)
End Using
End If
Return colcell
End Function).TakeWhile(Function(colcell) colcell IsNot Nothing).ToList()
End Sub
Private Sub MouseHandler(o As Object, e As MouseEventArgs)
Me.RefreshCell = GetUpdateCell(e.Location)
Me.RefreshCell.CellColor = Me.SelectedCellColor
Dim CellColorArea As Rectangle = Me.RefreshCell.Cell
CellColorArea.Inflate(-1, -1)
Me.UpdateCell = True
Me.Canvas.Invalidate(CellColorArea)
End Sub
Private Function GetUpdateCell(CellPosition As Point) As GridCell
Return Me.Grid.
SelectMany(Function(rowcells) rowcells).
Select(Function(gridcell) gridcell).
Where(Function(gridcell) gridcell.Cell.Contains(CellPosition)).
First()
End Function
Public Sub Dispose() Implements IDisposable.Dispose
If Me.Canvas IsNot Nothing Then
RemoveHandler Me.Canvas.Paint, AddressOf Me.ControlPaint
RemoveHandler Me.Canvas.MouseClick, AddressOf Me.MouseHandler
Me.Grid = Nothing
End If
End Sub
End Class

How to center a PictureBox inside a ScrollableControl and then autoscroll on resize

Having a bit of trouble trying to center the view on the center of the element inside a ScrollableControl.
I have no problems centering the control inside the ScrollableControl, however whenever I try to set AutoScrollPosition, the element inside the scroll container docks to the bottom right corner of the innermost container of the ScrollableControl.
Here is the code that I am using (and I am pretty sure the math is correct) :
MyBase.AutoScrollPosition = New System.Drawing.Point(Canvas1.Left - ((MyBase.Width - Canvas1.Size.Width) / 2), Canvas1.Top - ((MyBase.Height - Canvas1.Size.Height) / 2))
The type of project is actually a UserControl, not a Class, so this is not an "inherited" ScrollableControl per se. It is a UserControl type.
What I find most bizzare, is there doesn't appear to be a ScrollToX, only ScrollControlIntoView, and such, which do not do what I wish.
Basically, the end result, is the center of the Viewable area must be the center of the Control contained inside the Scrollable virtual area. I have the Control centered as such, so this is really just a matter of scrolling it into view so the X,Y of the dead center of the inner control, is in the dead center of the viewable area.
Current code for the entire class
Board.vb
Imports System.ComponentModel
Public Class Board
Private _init As Boolean = False
Private _keys As KeyEventArgs = Nothing
''' <summary>
''' </summary>
''' <filterpriority>3</filterpriority>
''' <remarks></remarks>
<Browsable(False), EditorBrowsable(False)> _
Shadows Property BackgroundImage As Image
Get
Return MyBase.BackgroundImage
End Get
Set(value As Image)
MyBase.BackgroundImage = value
End Set
End Property
<Browsable(False), EditorBrowsable(False)> _
Shadows Property AutoScroll As Boolean
Get
Return MyBase.AutoScroll
End Get
Set(value As Boolean)
MyBase.AutoScroll = value
End Set
End Property
<Browsable(False), EditorBrowsable(False)> _
Shadows Property AutoScrollMinSize As System.Drawing.Size
Get
Return MyBase.AutoScrollMinSize
End Get
Set(value As System.Drawing.Size)
MyBase.AutoScrollMinSize = value
End Set
End Property
Public Property Checkerboard As Boolean
Get
Return Canvas1.CheckeredBackground
End Get
Set(value As Boolean)
Canvas1.CheckeredBackground = value
End Set
End Property
Shadows Property BorderStyle As Windows.Forms.BorderStyle
Get
Return Canvas1.BorderStyle
End Get
Set(value As Windows.Forms.BorderStyle)
Canvas1.BorderStyle = value
End Set
End Property
Private Sub Canvas1_MouseEnter(sender As Object, e As EventArgs) Handles Canvas1.MouseEnter
Me.Focus()
End Sub
Public Sub Add(ByVal Image As System.Drawing.Image)
Dim l As New Layer("Layer " & Canvas1.Layers.Count + 1)
l.Graphics.Add(New Graphic(Image, New Point(10, 10)))
Canvas1.Layers.Add(l)
End Sub
Public Property CanvasSize() As System.Drawing.Size
Get
Return Canvas1.Size
End Get
Set(value As System.Drawing.Size)
Canvas1.Size = value
Me.CenterCanvas()
End Set
End Property
Public Property BoardSize() As System.Drawing.Size
Get
Return Me.AutoScrollMinSize
End Get
Set(value As System.Drawing.Size)
Me.AutoScrollMinSize = value
Me.CenterCanvas()
End Set
End Property
Public Function Remove(ByVal Index As Integer) As Boolean
Try
Canvas1.Layers.RemoveAt(Index)
Return True
Catch ex As Exception
Return False
End Try
End Function
Public Sub RefreshCanvas()
Canvas1.Invalidate()
End Sub
Public Sub CenterCanvas()
Canvas1.Location = New System.Drawing.Point((MyBase.DisplayRectangle.Width - Canvas1.Size.Width) / 2, (MyBase.DisplayRectangle.Height - Canvas1.Size.Height) / 2)
'Debug.Print(Canvas1.Top & ", " & Canvas1.Left)
' Dim y As Integer = (Me.Height - Canvas1.Height) / 2
' Dim x As Integer = (Me.Width - Canvas1.Width) / 2
' x = Canvas1.Left - x
' y = Canvas1.Top - y
' Me.AutoScrollPosition = New System.Drawing.Point(x, y)
End Sub
Public Sub New()
' This call is required by the designer.
InitializeComponent()
_init = True
' Add any initialization after the InitializeComponent() call.
Me.CenterCanvas()
End Sub
Private Sub Board_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
_keys = e
End Sub
Private Sub Board_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
_keys = Nothing
End Sub
Private Sub Board_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
Dim l As Layer
l = Canvas1.SelectedLayer
If IsNothing(l) = False Then
Debug.Print("Wheels")
End If
Dim MW As HandledMouseEventArgs = e
MW.Handled = False
End Sub
Private Sub Board_Resize(sender As Object, e As EventArgs) Handles Me.Resize
' If _init Then
' Dim x As Integer = Canvas1.Left - ((MyBase.Width - Canvas1.Size.Width) / 2)
'Dim y As Integer = Canvas1.Top - ((MyBase.Height - Canvas1.Size.Height) / 2)
' MyBase.AutoScrollPosition = New System.Drawing.Point(Canvas1.Left - ((MyBase.Width - Canvas1.Size.Width) / 2), Canvas1.Top - ((MyBase.Height - Canvas1.Size.Height) / 2))
'End If
MyBase.AutoScrollPosition = New System.Drawing.Point( _
Canvas1.Left - MyBase.AutoScrollPosition.X - ((MyBase.ClientSize.Width - Canvas1.Size.Width) \ 2), _
Canvas1.Top - MyBase.AutoScrollPosition.Y - ((MyBase.ClientSize.Height - Canvas1.Size.Height) \ 2))
End Sub
Private Sub Board_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
End Sub
End Class
Board.Designer.vb
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class Board
Inherits System.Windows.Forms.UserControl
'UserControl1 overrides dispose to clean up the component list.
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
Me.Canvas1 = New Artisto.Canvas()
CType(Me.Canvas1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'Canvas1
'
Me.Canvas1.Anchor = System.Windows.Forms.AnchorStyles.None
Me.Canvas1.CheckeredBackground = True
Me.Canvas1.Location = New System.Drawing.Point(0, 0)
Me.Canvas1.Name = "Canvas1"
Me.Canvas1.SelectedLayer = Nothing
Me.Canvas1.Size = New System.Drawing.Size(619, 317)
Me.Canvas1.TabIndex = 0
Me.Canvas1.TabStop = False
'
'Board
'
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Inherit
Me.AutoScroll = True
Me.AutoScrollMinSize = New System.Drawing.Size(4096, 2160)
Me.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink
Me.Controls.Add(Me.Canvas1)
Me.DoubleBuffered = True
Me.Name = "Board"
Me.Size = New System.Drawing.Size(1266, 523)
CType(Me.Canvas1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Friend WithEvents Canvas1 As Artisto.Canvas
End Class

Draw triangle VB.NET

Dear forum members I have to make a triangle class.
My problem is that I the public overrides sub teken does not work
IN MY CLASS FORM (FUNCTION RANDOMSTRAAL)
Private Function RandomStraal() As Int32
Return 20 + _Random.Next(Me.ClientSize.Width\2)
End Function
IN MY CLASS FORM (SUB MAAKTRIANGLE)
Private Sub MaakTriangle(x As Integer, y As Integer)
Dim tria As New Triangle(RandomKleur, RandomKleur, New Point(x, y), New Point(x, y + RandomStraal()), New Point(x + RandomStraal(), y))
tria.PenDikte = _Random.Next(1, 6)
_Tekening.Add(tria)
'_Tekening.Teken(Me.CreateGraphics)
Invalidate()
End Sub
MY CLASS TRIANGLE
Friend Class Triangle
Inherits Figuur
Public Property Point1() As Point
Public Property Point2() As Point
Public Property Point3() As Point
Private _Pointers() As Point = {Point1, Point2, Point3}
Public Sub New(penKleur As Color, vulKleur As Color, point1 As Point, point2 As Point, point3 As Point)
MyBase.New(penKleur, vulKleur)
Me.Point1 = point1
Me.Point2 = point2
Me.Point3 = point3
End Sub
Public Overrides Sub Teken( doek As Graphics)
Using borstel As New SolidBrush(VulKleur),
pen As New Pen(PenKleur, PenDikte)
Dim tria As New Rectangle(_Pointers) **'<--the problem**
doek.FillPolygon(borstel, tria)
doek.DrawPolygon(pen, tria)
End Using
End Sub
End Class
what should happen to do this work
thanks in advance
Two problems:
The Rectangle object doesn't take an array of pointers, and besides, you are trying to make a triangle, not a rectangle. Eliminate this:
' Dim tria As New Rectangle(_Pointers)
The second problem is you are referencing the _Pointers array, but they are not updated with the new coordinates. The points are all (0, 0):
Try it like this:
Public Overrides Sub Teken(doek As Graphics)
Using borstel As New SolidBrush(VulKleur), _
pen As New Pen(Me.PenKleur, Me.PenDikte)
Dim myPoints() As Point = New Point() {Point1, Point2, Point3}
doek.FillPolygon(borstel, myPoints)
doek.DrawPolygon(pen, myPoints)
End Using
End Sub
Side note: make sure you to use the Paint event of your control:
Private Sub Panel1_Paint(sender As Object, e As PaintEventArgs) _
Handles Panel1.Paint
e.Graphics.Clear(Color.White)
Dim tria As New Triangle(Color.Blue, Color.Red, New Point(64, 64), _
New Point(96, 96), _
New Point(32, 96))
tria.Teken(e.Graphics)
End Sub
or override the OnPaint method if drawing directly on a form.