Very new to Visual basic, and I need to set the background color of a Windows Form as a ColorBlend this is what I have so far. How do I finish it off?
Dim col As New ColorBlend
Dim myColours As Color() = {Color.Red, Color.Green}
col.Colors = myColours
Me.BackColor
I know this may seem a bit futile, but I need it for an assignment. Thanks
The code below works perfectly for me :
Protected Overrides Sub OnPaintBackground(ByVal pevent As System.Windows.Forms.PaintEventArgs)
'Define starters (the point [0,0] is the top-left corner of the form)
Dim y As Integer = 0
Dim x As Integer = 0
'Define the dimension (here it depends on your form dimension)
Dim wid As Integer = Me.Width
Dim hgt As Integer = Me.Height
Dim red_green_brush As New LinearGradientBrush(New Point(x, y), New Point(x + wid, y), Color.Red, Color.Green)
' ColorBlend.
pevent.Graphics.DrawString("ColorBlend", Me.Font, Brushes.Red, x, y)
y += 15
Dim color_blend As New ColorBlend(2)
color_blend.Colors = New Color() {Color.Red, Color.Green}
color_blend.Positions = New Single() {0.0, 1.0}
red_green_brush.InterpolationColors = color_blend
pevent.Graphics.FillRectangle(red_green_brush, x, y, wid, hgt)
red_green_brush.Dispose()
End Sub
Related
a strange phenomenon occurs.
With my edge detection program, I can transfer the inside of the GraphicsPath to a new image.
It always works great – except when I scale the original image with GIMP and Word (aspect ratio remains, only the dimensions are changed). Then the area is shifted. To the left and up. See attachement. In line 68, I looked what is in rectCutout. Everything OK.
Does this have anything to do with GIMP? The dots per inch are the same (72). The compression quality of the JPEG also (100%).
I just realized: if I scale an image larger, the result is completely black.
The strange thing is: I'm not saying: the picture that is drawn on is larger than the picture that is saved. Then it would be logical that the path is not in the same position. It's about the fact that the loaded image is just smaller.
I would be happy if someone could tell me why. 😄
this is the scaled image which is loaded
Here you see the GUI, ready to save
cropped image, area has x and y offset
#Disable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
Imports System.Drawing.Drawing2D
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class AllesGrafische
Public Shared Sub Paint_the_Rectangle(ByVal g As Graphics, ByVal recta As Rectangle)
If g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Using Pen_Hellblau As Pen = New Pen(Color.FromArgb(0, 200, 255), 1.0F)
g.DrawRectangle(Pen_Hellblau, recta)
End Using
End If
End Sub
Public Shared Sub Draw_Curve(ByVal g As Graphics, ByVal theList As List(Of Point))
If theList IsNot Nothing AndAlso theList.Count > 0 AndAlso g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Dim theList_neu As New List(Of Point)
Using gp As New GraphicsPath
For i As Integer = 1 To theList.Count - 1 Step 1
Dim a As Integer = theList(i).X
Dim b As Integer = theList(i).Y
Dim c As Integer = theList(i - 1).X
Dim d As Integer = theList(i - 1).Y
Dim Entfernungsbetrag As Double = Math.Sqrt(Math.Pow(a, 2) + Math.Pow(b, 2) + Math.Pow(c, 2) + Math.Pow(d, 2) - 2 * a * c - 2 * b * d)
If Entfernungsbetrag < Form1.erlaubte_Entfernung Then
theList_neu.Add(theList(i))
End If
Next
If theList_neu.Count = 0 Then Return
gp.AddLines(theList_neu.ToArray())
Using Pen_hellrosa As Pen = New Pen(Color.FromArgb(255, 64, 239), 1.0F)
g.DrawPath(Pen_hellrosa, gp)
End Using
If Form1.ClosePath Then
gp.CloseFigure()
End If
If Form1.CheckBox1.Checked Then
Dim Speicherpfad As String
Using SFD1 As New CommonSaveFileDialog
SFD1.Title = "Wo soll das Bild gespeichert werden?"
SFD1.Filters.Add(New CommonFileDialogFilter("PNG", ".png"))
If System.IO.Directory.Exists("C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen") Then
SFD1.InitialDirectory = "C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen"
Else
SFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
End If
If SFD1.ShowDialog = CommonFileDialogResult.Ok Then
Speicherpfad = SFD1.FileName & ".png"
Else
Return
End If
End Using
Using bmpSource As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As Matrix = New Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
Using graphicsCutout As Graphics = Graphics.FromImage(bmpCutout)
graphicsCutout.Clip = New Region(gp)
graphicsCutout.DrawImage(bmpSource, CInt(-rectCutout.Left), CInt(-rectCutout.Top))
bmpCutout.Save(Speicherpfad, Imaging.ImageFormat.Png)
Form1.CheckBox1.Checked = False
End Using
End Using
End Using
End If
End Using
End If
End Sub
End Class
#Enable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
The solution is to use .SetResolution()
Using Original As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As System.Drawing.Drawing2D.Matrix = New System.Drawing.Drawing2D.Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
bmpCutout.SetResolution(Original.HorizontalResolution, Original.VerticalResolution)
.
.
.
.
.
I have developed coding in vb.net to insert media player and also i am able to add all features to media player like time, seek bar but for my project, it is mandatory to show flexible grid over the playing video which requires advanced level of programming.I learned to add lines grids on a form but forming grids over playing video and transform it size graphically is difficult,i would be glad if you help me...thank you in advance
the following code help in forming grids but it cannot be transformed and also it cannot be placed over media player
Option Strict On
Option Explicit On
Option Infer Off
Public Class Form1
Sub DrawGrid(g As Graphics, origin As Point, rows As Integer, columns As Integer, cellSize As Size)
Dim gridWidth As Integer = columns * cellSize.Width
Dim gridHeight As Integer = rows * cellSize.Height
Dim left As Integer = origin.X - (gridWidth \ 2)
Dim right As Integer = origin.X + (gridWidth \ 2)
Dim top As Integer = origin.Y - (gridHeight \ 2)
Dim bottom As Integer = origin.Y + (gridHeight \ 2)
For y As Integer = top To bottom + 1 Step cellSize.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 cellSize.Width
Dim pt1 As New Point(x, top)
Dim pt2 As New Point(x, bottom)
g.DrawLine(Pens.Black, pt1, pt2)
Next
g.DrawEllipse(Pens.Red, New Rectangle(origin.X - 5, origin.Y - 5, 10, 10))
End Sub
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
Dim origin As New Point(Me.ClientRectangle.Width \ 2, Me.ClientRectangle.Height \ 2)
Dim cellSize As New Size(10, 10)
Dim rowCount As Integer = 10
Dim columnCount As Integer = 10
DrawGrid(e.Graphics, origin, rowCount, columnCount, cellSize)
End Sub
End Class
I have been working on an app to search for 3 pixels in a certain area then play a sound. It currently works however I wish to reduce the zone of which it searches from the whole screen to a rectangular area on my screen, this is to save memory usage of the app, here's the code that works
Private Sub dcdTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles dcdTimer.Tick
Dim screensize As Size = New Size(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim screenshot As New Bitmap(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim ge As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(screenshot)
Dim pointx As Integer = 1
Dim pointy As Integer = 1
ge.CopyFromScreen(New Point(0, 0), New Point(0, 0), screensize)
looking = True
Try
While looking = True
Dim atpoint As Color = screenshot.GetPixel(pointx, pointy)
Dim reckcol1 As Color = Color.FromArgb(a, r, g, b) 'first pixel colour
Dim reckcol2 As Color = Color.FromArgb(a1, r1, g1, b1) 'second pixel colour
Dim reckcol3 As Color = Color.FromArgb(a2, r2, g2, b2) 'third pixel colour
If atpoint = reckcol1 Then 'Matches 3 pixels
Dim testPoint As Color = screenshot.GetPixel(pointx, pointy + 10)
If testPoint = reckcol2 Then
Dim testPoint2 As Color = screenshot.GetPixel(pointx + 10, pointy + 10)
If testPoint2 = reckcol3 Then
My.Computer.Audio.Play(sounddir + "Found.wav")
looking = False
Sleep(15000)
pointx = 0
pointy = 0
End If
End If
End If
pointy = pointy + 1
If pointy = My.Computer.Screen.Bounds.Height Then
pointy = 0
pointx = pointx + 1
End If
End While
Catch ex As Exception
End Try
End Sub
I tried to use this code as suggested:
Dim pointofY As New Point(500, 400)
Dim screensize As New Size(400, 200)
Dim screenshot As New Rectangle(pointofY, screensize)
Dim ge As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(screenshot)
However, using a rectangle does not allow me to use getpixel or use ge.copyfromscreen
Hey I am able to set the color of image via set Pixel Property but when i put condition getPixel then no error occurs but the programme stucks
i put the code below please check it give me the solution :
Dim b As Bitmap = New Bitmap("D:\test.bmp")
' Make Image Indexed
Dim nii As New Bitmap(b.Width, b.Height,
System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
For y As Integer = 0 To nii.Height - 1
For x = 0 To nii.Width - 1
Dim cw As New Color
cw = Color.Black
If nii.GetPixel(x, y) = cw Then
nii.SetPixel(x, y, Red)
End If
Next
Next
PictureBox1.Image = FromFile("D:\test.bmp")
PictureBox2.Image = nii
If i removed getPixel then programme works but full image color is going to be red.
You need to compare the ARGB values of color
Dim cw As New Color
cw = Color.Black
dim curPixColor as Color = b.GetPixel(x, y)
If curPixColor.ToArgb = cw.ToArgb Then
nii.SetPixel(x, y, Color.Red)
End If
Or you should use the Equality Operator
Dim cw As New Color
cw = Color.Black
dim curPixColor as Color = b.GetPixel(x, y)
If Color.op_Equality(curPixColor, cw) Then
nii.SetPixel(x, y, Color.Red)
End If
Reference:http://msdn.microsoft.com/en-us/library/system.drawing.color.op_equality(v=vs.110).aspx
Edit:
As you are getting pixel from a bmp there is no transparency supported. so your comparing color should be
cw = Color.FromArgb(0,0,0,0)
Edit2:
you are reading pixed from nii you should be reading from b
dim curPixColor as Color = b.GetPixel(x, y)
full code should be something like (tested)
Dim b As Bitmap = New Bitmap("D:\test.bmp")
' Make Image Indexed
Dim nii As New Bitmap(b.Width, b.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
For y As Integer = 0 To nii.Height - 1
For x = 0 To nii.Width - 1
Dim cw As New Color
cw = Color.Black
Dim curPixColor As Color = b.GetPixel(x, y)
If curPixColor.ToArgb() = cw.ToArgb() Then
nii.SetPixel(x, y, Color.Red)
Else
nii.SetPixel(x, y, curPixColor)
End If
Next
Next
PictureBox1.Image = Image.FromFile("D:\test.bmp")
PictureBox2.Image = nii
I had a similar problem, but comparing the RGB values worked. Thanks!
In fact, instead of too many variables, you can just do:
If b.GetPixel(x,y).ToArgb() = Color.Black.ToArgb() then......
I have a program which writes to a .log file as it is installing software.
Some of the lines will contain either WARNING or FAILED.
What I would like, is a window in my program which will read the .log file and display the content into this window as it is being written too. Any lines which contain WARNING or FAILED in them are highlighted yellow/red.
Does anyone know how to do this?
Create a FORM (I used VB 2010) and add this code.
it will write 3 lines on the form in 2 colours.
It might get you on your way. Ask MSDN help for each function that is new to you.
Private Sub Form1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim chRs(0) As CharacterRange
Dim sbRs(0) As SolidBrush
Dim flRs(0) As SolidBrush
Dim blueBrush As New SolidBrush(Color.Blue)
Dim whiteBrush As New SolidBrush(Color.White)
Dim redBrush As New SolidBrush(Color.Red)
Dim EditFont As New Font("Courier New", 9)
Dim stringFormat As New StringFormat
Dim aRectangle As Rectangle
Dim RectHeight As Integer = 20
For i = 1 To 3
Dim txt As String = "a string " & CStr(i)
If i = 2 Then
sbRs(0) = blueBrush
Else
sbRs(0) = redBrush
End If
flRs(0) = whiteBrush
chRs(0) = New CharacterRange(0, txt.Length())
Dim chRsa As Array = Array.CreateInstance(GetType(CharacterRange), 1)
Array.Copy(chRs, 0, chRsa, 0, 1)
aRectangle = New Rectangle(0, CInt((i - 1) * RectHeight), ClientRectangle.Size.Width, RectHeight) ' x, y, w, h
stringFormat.SetMeasurableCharacterRanges(chRsa)
Dim stringRegions As Array = Array.CreateInstance(GetType([Region]), 1)
stringRegions = e.Graphics.MeasureCharacterRanges(txt, EditFont, aRectangle, stringFormat)
Dim measureRect1 As RectangleF = stringRegions(0).GetBounds(e.Graphics)
Dim g As Graphics = e.Graphics
g.FillRectangle(flRs(0), measureRect1)
g.DrawString(txt.Substring(chRs(0).First, chRs(0).Length), EditFont, sbRs(0), CSng(measureRect1.X), CSng(measureRect1.Y))
Next
End Sub