I am developing LEDBOARD user control in vb.net.I have done it also .Actually its taking too much time to load .In the vb6 same application I am loading 3000 labels using a label control array but not time consuming .In vb.net I am doing same but it's taking too much time to load 3000 labels.Is there any other way(any control or any custom control) to draw input text(any font style),image like below image
It looks like below
Create your LedBoard control from scratch by inheriting from Control, instead of using a UserControl and adding tons of labels.
I just made a little test to show you what I mean. You will have to adapt the logic to meet your needs.
Public Class LedBoard
Inherits Control
Private _rand As Random = New Random()
Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
e.Graphics.FillRectangle(Brushes.Black, 0, 0, Width, Height)
Const nx As Integer = 40, ny As Integer = 25
Dim w = CInt((Width - 1) / nx) - 1
Dim h = CInt((Height - 1) / ny) - 1
For x As Integer = 0 To nx - 1
For y As Integer = 0 To ny - 1
If _rand.NextDouble() < 0.8 Then
e.Graphics.FillRectangle(Brushes.Red, x * (w + 1) + 1, y * (h + 1) + 1, w, h)
End If
Next
Next
End Sub
End Class
Related
I have a program that take an image and changes it to 1 bit B&W. It uses Lockbyte software to make it faster. BUT, when running it, it takes over a minute to process one image. When looking at the CPU usage it is only 5% at most once it is running. Is there a way to get the computer to use more CPU time? The indicator is showing that the computer is running below 50%, as low as 25%.
I just had one DUH thought, I forgot to add the resizing function into my program. It should help but I know I need to make the conversion faster yet. The program will be used to do 100 to 300 images per batch.
Most other programs I have seen do a conversion within a few seconds per image. I would like to get to something like this too.
This is the program. Mostly cobbled together from samples. I only half understand it but can read it. Sorry to the contributors that I cannot give credit to them. I didn't keep track of them.
Public Class Form1
Public Shared Function ConvertTo1Bit(ByVal input As Bitmap) As Bitmap
Dim masks = New Byte() {&H80, &H40, &H20, &H10, &H8, &H4, &H2, &H1}
Dim output = New Bitmap(input.Width, input.Height, PixelFormat.Format1bppIndexed)
Dim data = New SByte(input.Width - 1, input.Height - 1) {}
Dim inputData = input.LockBits(New Rectangle(0, 0, input.Width, input.Height), ImageLockMode.[ReadOnly], PixelFormat.Format24bppRgb)
Try
Dim scanLine = inputData.Scan0
Dim line = New Byte(inputData.Stride - 1) {}
Dim y = 0
While y < inputData.Height
Marshal.Copy(scanLine, line, 0, line.Length)
For x = 0 To input.Width - 1
data(x, y) = CSByte((64 * (GetGreyLevel(line(x * 3 + 2), line(x * 3 + 1), line(x * 3 + 0)) - 0.5)))
Next
y += 1
scanLine += inputData.Stride
End While
Finally
input.UnlockBits(inputData)
End Try
Dim outputData = output.LockBits(New Rectangle(0, 0, output.Width, output.Height), ImageLockMode.[WriteOnly], PixelFormat.Format1bppIndexed)
Try
Dim scanLine = outputData.Scan0
Dim y = 0
While y < outputData.Height
Dim line = New Byte(outputData.Stride - 1) {}
For x = 0 To input.Width - 1
Dim j = data(x, y) > 0
Try
If j Then
line(x / 8) = line(x / 8) Or masks(x Mod 8)
End If
Catch ex As Exception
End Try
Dim [error] = CSByte((data(x, y) - (If(j, 32, -32))))
If x < input.Width - 1 Then data(x + 1, y) += CSByte((7 * [error] / 16))
If y < input.Height - 1 Then
If x > 0 Then data(x - 1, y + 1) += CSByte((3 * [error] / 16))
data(x, y + 1) += CSByte((5 * [error] / 16))
If x < input.Width - 1 Then data(x + 1, y + 1) += CSByte((1 * [error] / 16))
End If
Next
Marshal.Copy(line, 0, scanLine, outputData.Stride)
y += 1
scanLine += outputData.Stride
End While
Finally
output.UnlockBits(outputData)
End Try
Return output
End Function
Public Shared Function GetGreyLevel(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) As Double
Return (r * 0.299 + g * 0.587 + b * 0.114) / 255
End Function
Private Sub btBrowesIn_Click(sender As Object, e As EventArgs) Handles btBrowesIn.Click
FolderBrowserDialog1.ShowDialog()
tbInPic.Text = FolderBrowserDialog1.SelectedPath
End Sub
Private Sub btBrowesOut_Click(sender As Object, e As EventArgs) Handles btBrowesOut.Click
FolderBrowserDialog2.ShowDialog()
tbInPic.Text = FolderBrowserDialog2.SelectedPath
End Sub
Private Sub btGo_Click(sender As Object, e As EventArgs) Handles btGo.Click
Dim Infiles As Array
Dim opf As New OpenFileDialog
opf.Filter = "Choose Image(*.jpg;*.png;*.gif)|*.jpg;*.png;*.gif"
If opf.ShowDialog = DialogResult.OK Then
PictureBox1.Image = Image.FromFile(opf.FileName)
Dim MyBitmap As New Bitmap(PictureBox1.Image)
PictureBox2.Image = ConvertTo1Bit(MyBitmap)
End If
End Sub
End Class
The program will be used to do 100 to 300 images per batch.
You can process the images asynchronously. .Net provides several ways to do this: Async/Await, raw Tasks, ThreadPool, raw Threads, BackgroundWorker, probably more. Which is most appropriate here depends on the context of the application.
For fun I'm trying to recreate the first level of one my favorite games, Fire Emblem 7. I got a picture of the map online. I've broken down the image into "squares" with each square assigned a picture box to display the image. This is because each square needs to have certain properties such as terrain values, units inside them, etc.
The actual image is quite small (240 x 160), so I want to be able to scale it to any user defined value. The size of each square should be 16c x 16c with a scaler of c (all map dimensions are divisible by 16). For some reason, when c > 1, white lines appear between the squares. I've check the code and it looks like the squares should be adjacent with no empty spaces regardless of c.
I have provided a piece of my code and links to the images of different values of c below. Thank you for you help.
'This Sub Creates The Map From Initial Image And Assigns Part Of Image to Each Square
Public Sub New(Name As String, Image As Image)
Dim cropRect As Rectangle
Dim cropImage As Bitmap
Me.Name = Name
Me.Image = Image
Height = Me.Image.Height / 16
Width = Me.Image.Width / 16
ReDim Squares(Height - 1, Width - 1)
For i = 0 To Height - 1
For j = 0 To Width - 1
cropRect = New Rectangle(16 * j, 16 * i, 16, 16)
cropImage = New Bitmap(16, 16)
Graphics.FromImage(cropImage).DrawImage(Me.Image, 0, 0, cropRect, GraphicsUnit.Pixel)
Squares(i, j) = New Square(cropImage)
Next
Next
End Sub
'This Sub Sizes Each Square With User Defined Scale Value
Public Sub Draw(Scale As Double)
For i = 0 To Height - 1
For j = 0 To Width - 1
With Squares(i, j).Box
.Size = New Size(16 * Scale, 16 * Scale)
.Location = New Point(16 * j * Scale, 16 * i * Scale)
.SizeMode = PictureBoxSizeMode.StretchImage
End With
Next
Next
End Sub
I have written a program in VB.NET to generate just one face of a YCbCr colour space cube. I want the final image to look similar to the CbCr plane at constant luma on Wikipedia (where Y=1).
Ultimately, I want to create images of all 6 faces of the cube, so that I can make an animated 3D cube in Photoshop (I already know how to create the cube in Photoshop once I have images of its faces). The finished cube will look similar to the YUV cube on the softpixel website.
Below is the output of my program and the code so far. I had no trouble generating the faces of an RGB colour space cube, but the YCbCr cube is proving problematic. I have applied a YCbCr conversion formula to each pixel in the face of an RGB cube, but the centre of the front face should be white and the centre of the opposite face should be black. Can someone please tell me what code I am missing?
Public Class Form2
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
PictureBox1.Width = 255
PictureBox1.Height = 255
'create new bitmap
Dim newbmp As Bitmap = New Bitmap(255, 255)
'Generate the new image
Dim x As Integer
Dim y As Integer
For y = 0 To 254
For x = 0 To 254
Dim yval As Integer
Dim cb As Integer
Dim cr As Integer
'Convert to YCbCr using these formulas
'0+(0.299*RED)+(0.587*GREEN)+(0.114*BLUE)
'128-(0.168736*RED)-(0.331264*GREEN)+(0.5*BLUE)
'128+(0.5*RED)-(0.418688*GREEN)-(0.081312*BLUE)
yval = Math.Floor(0 + (0.299 * x) + (0.587 * y) + (0.114 * 255))
cb = Math.Floor(128 - (0.168736 * x) - (0.331264 * y) + (0.5 * 255))
cr = Math.Floor(128 + (0.5 * x) - (0.418688 * y) - (0.081312 * 255))
newbmp.SetPixel(x, y, Color.FromArgb(yval, cb, cr))
Next x
Next y
'load image into picturebox
PictureBox1.Image = newbmp
End Sub
End Class
I want to make a custom polygon shape class, which i can drag and drop unto my form at will (just as it is done in the case of OvalShape and RectangleShape objects in VS toolbox). I checked site1, site2 and site3, one of which specifically said that the OnPaint Event of my form should be overridden. Is there any way I can achieve the same while creating the custom polygon shape, and still have my polygon appear on the toolbox?
Edit:
#Jens: I'll like the control to generate its code with the following tested code:
Me.ClientSize = New Point(24, 24)
Dim r1 As Integer = Min(cx, cy) - 10
Dim r2 As Integer = Min(cx, cy) \ 2
Dim pts(9) As Point
For i As Integer = 0 To 9 Step 2
pts(i).X = cx + CInt(r1 * Cos(i * PI / 5 - PI / 2))
pts(i).Y = cy + CInt(r1 * Sin(i * PI / 5 - PI / 2))
pts(i + 1).X = cx + CInt(r2 * Cos((i + 1) * PI / 5 - PI / 2))
pts(i + 1).Y = cy + CInt(r2 * Sin((i + 1) * PI / 5 - PI / 2))
Next i
That gives me a star with 5 spikes. How can i store them in the Points variable created,
OR
store the points as a region so that whenever i change forecolor, it fills the region (i.e. polygn) with the selected color. I also want to prevent painting the backcolor. Please take a look at the links below to a c# solution of what i really want, but i suck at converting c# to vb.
link1; Link2
Thanks a lot
I am not entirely sure that that is what you want. You can always derive a new class from Control and use its Paint event to draw whatever you like. In your case a polygon.
The control therefore contains a Points property that is just an array of PointF values that define the edges of the polygon. By using the DesignerSerializationVisible.Content attribute you make it possible to edit these values through the designer directly. The code looks like this:
Public Class PolygonControl
Inherits Control
Private _Points(2) As PointF
<System.ComponentModel.DesignerSerializationVisibility(System.ComponentModel.DesignerSerializationVisibility.Content)>
Public Property Points As PointF()
Get
Return _Points
End Get
Set(value As PointF())
_Points = value
End Set
End Property
Public Property LineColor As Color = Color.Black
Public Property LineWidth As Integer = 2
Private Sub PolygonControl_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
e.Graphics.Clear(Me.BackColor)
If Points IsNot Nothing AndAlso Points.Count > 1 Then
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Using b As New SolidBrush(ForeColor)
Using p As New Pen(b, LineWidth)
e.Graphics.DrawPolygon(p, Points)
End Using
End Using
End If
End Sub
End Class
I added a color and width property as well. This is just to give you a rough idea. Notice the attribute above the Points property.
In "action" it looks like this:
Adding better designer support is certainly possible, but I have no experience with that whatsoever. But it is a start.
Edit
Since you always draw the same shape, you can precalculate the points in the control's constructor and just draw the shape in the paint event:
Public Class StarControl
Inherits Control
'Storage for the shape's points
Private pts(9) As Point
'Constructor
Public Sub New()
Me.ClientSize = New Size(24, 24)
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
Me.BackColor = Color.Transparent
'Precalculate the shape
Dim cx = CInt(Me.ClientSize.Width / 2)
Dim cy = CInt(Me.ClientSize.Height / 2)
Dim r1 As Integer = Min(cx, cy) - 10
Dim r2 As Integer = Min(cx, cy) \ 2
ReDim pts(9)
For i As Integer = 0 To 9 Step 2
pts(i).X = cx + CInt(r1 * Cos(i * PI / 5 - PI / 2))
pts(i).Y = cy + CInt(r1 * Sin(i * PI / 5 - PI / 2))
pts(i + 1).X = cx + CInt(r2 * Cos((i + 1) * PI / 5 - PI / 2))
pts(i + 1).Y = cy + CInt(r2 * Sin((i + 1) * PI / 5 - PI / 2))
Next i
End Sub
Public Property LineColor As Color = Color.Black
Public Property FillColor As Color = Color.Gold
Public Property LineWidth As Integer = 1
Public Sub PaintMe(sender As Object, e As PaintEventArgs) Handles Me.Paint
'Draw the precalculated shape
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Using b As New SolidBrush(FillColor)
e.Graphics.FillPolygon(b, pts)
End Using
Using b As New SolidBrush(LineColor)
Using p As New Pen(b, LineWidth)
e.Graphics.DrawPolygon(p, pts)
End Using
End Using
End Sub
End Class
For an even cooler effect move the shape calculation into the Paint event handler so the shape resizes itself based on the control's size. This allows you to draw stars of arbitrary size.
Here is an image of what I am trying to achieve:
As you can see, there is a slight reflection under the progress bar.
I have a custom progress bar that is heavily based on this code:
http://www.codeproject.com/Articles/19309/Vista-Style-Progress-Bar-in-C
Note: My code is in VB.
Problem - I would like to draw a reflection of that progress bar under it so it looks similar to the image I have given above. I have been told that one way to do it is using pixels, which need to be done manually. Is that the only option? Is there any other/easier way to do it?
I appreciate your help.
Thanks!
Are you looking for something like this?
Here is the code:
Dim pgBarReflection As New Bitmap(ProgressBar1.Width, 20)
ProgressBar1.DrawToBitmap(pgBarReflection, ProgressBar1.ClientRectangle)
For x As Integer = 0 To pgBarReflection.Width - 1
For y As Integer = 0 To pgBarReflection.Height - 1
Dim alpha = 255 - 255 * y \ pgBarReflection.Height
Dim clr As Color = pgBarReflection.GetPixel(x, y)
clr = Color.FromArgb(alpha, clr.R, clr.G, clr.B)
pgBarReflection.SetPixel(x, y, clr)
Next y
Next x
Me.CreateGraphics.DrawImage(pgBarReflection, New Point(ProgressBar1.Left, ProgressBar1.Bottom + 10))
If you want greyscale shadow, replace this line
clr = Color.FromArgb(alpha, clr.R, clr.G, clr.B)
with these two:
Dim greyScale As Integer = CInt(clr.R * 0.3 + clr.G * 0.59 + clr.B * 0.11)
clr = Color.FromArgb(alpha, greyScale, greyScale, greyScale)
You will get something like this:
You can play with parameters to make the shadow more realistic.
Solution is based on this article:
Draw an image with gradient alpha (opacity) values in VB.NET
This solution serves more code but is many times faster than GetPixel/SetPixel. It has one overload without any further settings, or you can use it with alpha start and stop value as well as how much you want to "squeeze" the reflection.
The overloaded simple version assume the background color to be that of the parent. Please note that it has no error checking. You will of course need to implement this in production code.
The result will be like this: (a big thanks to Neolisk for going through the extra trouble producing an image from the code)
The is still room for optimizations (working with "squeezed" version only, un-boxing calculations etc.), but I'll leave that as an execise for the user :-)
Private Sub DrawControlReflection(c As Control)
DrawControlReflection(c, c.Parent.BackColor, 1, 0, 1, 7) 'set you defaults here
End Sub
''' <summary>
''' Draws an reflection of a control
''' </summary>
''' <param name="c">The control to make an reflection of</param>
''' <param name="bgCol">Background color in transparent area</param>
''' <param name="startTrans">0.0-1.0, start value of reflection transparency, usually 1</param>
''' <param name="endTrans">0.0-1.0, end value of reflection transparency, usually 0</param>
''' <param name="squeeze">height of reflection, values 0-1, 1=100%, 0.5=50% etc.</param>
''' <param name="delta">y offset of reflection from control's bottom</param>
''' <remarks>
''' Provided AS-IS.
''' Created by Epistmex, use as you want.
''' Need implementation of error checking (bitmap allocations etc.)
''' </remarks>
Private Sub DrawControlReflection(c As Control,
bgCol As Color,
startTrans As Single,
endTrans As Single,
squeeze As Single,
delta As Integer)
'
'-- Original control's bound
'
Dim r As Rectangle = c.ClientRectangle
'
'-- Destination bound
'
Dim rd As Rectangle = New Rectangle(c.Left,
c.Top + r.Height + 1 + delta,
r.Width,
CInt(r.Height * squeeze))
'
'-- Create a bitmap for reflection and copy control content into it
'
Dim bmp As New Bitmap(r.Width,
r.Height,
Imaging.PixelFormat.Format24bppRgb)
c.DrawToBitmap(bmp, r)
'
'-- flip it vertically
'
bmp.RotateFlip(RotateFlipType.RotateNoneFlipY)
'
'-- Add gradient "transparency" to bitmap
'
AddGradientAlpha(bmp, r, startTrans, endTrans, bgCol)
'
'-- Draw the result
'
Dim g As Graphics = c.Parent.CreateGraphics
if squeeze <> 1 Then g.InterpolationMode = _
Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(bmp, rd)
g.Dispose()
bmp.Dispose()
End Sub
Private Sub AddGradientAlpha(ByRef bmp As Bitmap, r As Rectangle, s As Single, e As Single, bc As Color)
Dim bmpLock As Imaging.BitmapData = bmp.LockBits(r, Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format24bppRgb)
Dim st As Integer = bmpLock.Stride
Dim bytesBmp(bmpLock.Stride * bmp.Height) As Byte
Runtime.InteropServices.Marshal.Copy(bmpLock.Scan0, bytesBmp, 0, bytesBmp.Length)
'
'-- Calculate and create pre-multiplied gradient alpha
'
Dim x, y, dx, l, d As Integer
Dim aDiff As Double = s - e
Dim a As Double
Dim b As Byte
Dim h As Integer = bmp.Height - 1
For y = 0 To h
l = y * st 'line. cache the calculations we can
d = h - y 'position with opposite value
If d = 0 Then
a = e
Else
a = (aDiff * d / h) + e 'gradient value ad 0.5 to h for even more accuracy
End If
If a < 0 Then a = 0
If a > 1 Then a = 1
a = a * a 'power of 2 to make gradient steeper
For x = 0 To bmp.Width - 1
dx = l + x * 3 'x pos in buffer
'make gradient of colors in buffer + mix bg color
bytesBmp(dx) = CByte(bytesBmp(dx) * a + ((1 - a) * bc.B))
bytesBmp(dx + 1) = CByte(bytesBmp(dx + 1) * a + ((1 - a) * bc.G))
bytesBmp(dx + 2) = CByte(bytesBmp(dx + 2) * a + ((1 - a) * bc.R))
Next
Next
'
'-- Marshal back
'
Runtime.InteropServices.Marshal.Copy(bytesBmp, 0, bmpLock.Scan0, bytesBmp.Length)
bmp.UnlockBits(bmpLock)
End Sub