EDN Admin
Well-known member
Hi
Im hoping you can help me out here. Ive written a graphics app. One of the things I want to do is rubber banding. I know that GD+ andVb.Net dont support this. So Ive written my own sw to do this. The thing is that it works ok with jpgs newly created in MS Paint and my app and some d/l from the Net. It also works with most PNGs. BUT it does NOT work with jpgs from DSLR cameras from Nikon, Canon and Fujifilm.
I dont know why. It seems that VB.Nets functions for reading and writing colours to jpgs isnt working right for jpgs from DSLRs or from my scanner. My actual drawing code works - i.e. it properly draws circles, rectangles, etc. BUT the XORing doesnt work right on many images as Ive described.
Maybe you can explain why.
Allan
My module code (so far)is:
Option Explicit On
Option Strict On
Module modBresenham
Sub Swap(ByRef X As Int32, ByRef Y As Int32)
Dim temp As Int32 = X
X = Y
Y = temp
End Sub
Info for maybe later use:
If the plot function returns true, the Bresenhams line routine continues.
if the plot function returns false, the algorithm stops
Delegate Function PlotFunction(ByVal x As Int32, ByVal y As Int32, ByVal colour As Color, ByVal gr As Graphics, ByVal ROP As Integer) As Boolean
Public Sub BresenhamLine(ByVal x1 As Int32, ByVal y1 As Int32, ByVal x2 As Int32, ByVal y2 As Int32, ByVal colour As Color, ByVal gr As Graphics)
Note- this needs modifying to do full length fancy dashed-dotted etc. iines
Hmmm it may occasionally leave small traces of artifacts on loaded images when erased - even though it shouldnt
Note: the line drawn here is deliberately NOT anti-aliased (so expect some stepping for diagonal lines)
Dim steep As Boolean = (Math.Abs(y2 - y1) > Math.Abs(x2 - x1))
If (steep) Then
Swap(x1, y1)
Swap(x2, y2)
End If
If (x1 > x2) Then
Swap(x1, x2)
Swap(y1, y2)
End If
Dim deltaX As Int32 = x2 - x1
Dim deltaY As Int32 = y2 - y1
Dim err As Int32 = CInt(CLng(deltaX / 2))
Dim ystep As Int32
Dim y As Int32 = y1
If (y1 < y2) Then
ystep = 1
Else
ystep = -1
End If
For x As Int32 = x1 To x2
If (steep) Then
plotPoint(y, x, colour, gr, 0)
Else
plotPoint(x, y, colour, gr, 0)
End If
Next
End Sub
Public Sub BresenhamCircle(ByVal centreX As Int32, ByVal centreY As Int32, ByVal radius As Int32, ByVal colour As Color, ByVal gr As Graphics)
Dim x As Int32 = 0, y As Int32 = radius
Dim d As Int32 = 3 - (2 * radius)
Draws a damned fast and good solid circle
Note that this IS suitable for use with flood-fills!!!!!!
Hmmm it may occasionally leave small traces of artifacts on loaded images when erased - even though it shouldnt
Draw 8 points at a time covering all four quadrants
While (y > x)
plotPoint(centreX + x, centreY + y, colour, gr, 0)
plotPoint(centreX + y, centreY + x, colour, gr, 0)
plotPoint(centreX - x, centreY + y, colour, gr, 0)
plotPoint(centreX + y, centreY - x, colour, gr, 0)
plotPoint(centreX - x, centreY - y, colour, gr, 0)
plotPoint(centreX - y, centreY - x, colour, gr, 0)
plotPoint(centreX + x, centreY - y, colour, gr, 0)
plotPoint(centreX - y, centreY + x, colour, gr, 0)
If (d < 0) Then
d += (4 * x) + 6
Else
d += (4 * (x - y)) + 10
y -= 1
End If
x += 1
End While
Make sure we draw the extreme points at top, bottom, left and right of the circle
plotPoint(centreX, centreY + radius, colour, gr, 0)
plotPoint(centreX, centreY - radius, colour, gr, 0)
plotPoint(centreX + radius, centreY, colour, gr, 0)
plotPoint(centreX - radius, centreY, colour, gr, 0)
End Sub
Public Sub Rectangle(ByVal x1 As Int32, ByVal y1 As Int32, ByVal x2 As Int32, ByVal y2 As Int32, ByVal colour As Color, ByVal gr As Graphics)
BresenhamLine(CInt(x1), CInt(y1), CInt(x2), CInt(y1), colour, gr) Draw a line between the points
BresenhamLine(CInt(x2), CInt(y1), CInt(x2), CInt(y2), colour, gr) Draw a line between the points
BresenhamLine(CInt(x2), CInt(y2), CInt(x1), CInt(y2), colour, gr) Draw a line between the points
BresenhamLine(CInt(x1), CInt(y2), CInt(x1), CInt(y1), colour, gr) Draw a line between the points
End Sub
Public Sub plotPoint(ByVal x As Int32, ByVal y As Int32, ByVal newcolour As Color, ByVal gr As Graphics, ByVal ROP As Integer)
Dim oldcolor As Color = DirectCast(Form1.PictureBox1.Image, Bitmap).GetPixel(x, y)
Note: ROP is passed as an integer - this is so that it will let me code other Raster Operations later
Try
Get the old colour
Dim oldcolour As Color = Form1.currentbitmap.GetPixel(x, y) Hmmm a bit too application specific here
Dim xorcolour As Color
Define variables to hold the xored values
Dim xa As Int32
Dim xr As Int32
Dim xg As Int32
Dim xb As Int32
Get the alpha, red, green, blue values of the old colour
Dim a1 As Int32 = oldcolour.A
Dim r1 As Int32 = oldcolour.R
Dim g1 As Int32 = oldcolour.G
Dim b1 As Int32 = oldcolour.B
Get the alpha, red, green, blue values of the new colour
Dim a2 As Int32 = newcolour.A
Dim r2 As Int32 = newcolour.R
Dim g2 As Int32 = newcolour.G
Dim b2 As Int32 = newcolour.B
Form1.OldColourToolStripStatusLabel.Text =oldcolour.Name Hmmm a bit too application specific here
What I evenually intend to do here is to read the colour already plotted and appy a Boolean logic operator on with the new colour
Note the messing about that we have to do in order to plot a single pixel in .Net
Dim bm As New Bitmap(1, 1) Create new bitmap of size(1x1 pixel)
Ok we have the old colour component values and the new color component values so do the raster op here
xor the components from both colours
xa = a1 We dont actually want to xor the alpha channels - well just leave that as is to preserve the transparency of the current bitmap
xr = (r1 Xor r2) xor the red components
xg = (g1 Xor g2) xor the green components
xb = (b1 Xor b2) xor the blue components
Plot the point
xorcolour = Color.FromArgb(xa, xr, xg, xb) Convert the xored components into a colour
bm.SetPixel(0, 0, xorcolour) Set that single pixel to the desired xored colour
gr.DrawImageUnscaled(bm, CInt(x), CInt
) Draw the single pixel bitmap onto the graphics object
bm.Dispose() Done with the 1x1 bitmap so dispose of it
Catch ex As Exception
MsgBox("Whoops!" & ex.Message)
Exit Sub
End Try
End Sub
End Module
View the full article
Im hoping you can help me out here. Ive written a graphics app. One of the things I want to do is rubber banding. I know that GD+ andVb.Net dont support this. So Ive written my own sw to do this. The thing is that it works ok with jpgs newly created in MS Paint and my app and some d/l from the Net. It also works with most PNGs. BUT it does NOT work with jpgs from DSLR cameras from Nikon, Canon and Fujifilm.
I dont know why. It seems that VB.Nets functions for reading and writing colours to jpgs isnt working right for jpgs from DSLRs or from my scanner. My actual drawing code works - i.e. it properly draws circles, rectangles, etc. BUT the XORing doesnt work right on many images as Ive described.
Maybe you can explain why.
Allan
My module code (so far)is:
Option Explicit On
Option Strict On
Module modBresenham
Sub Swap(ByRef X As Int32, ByRef Y As Int32)
Dim temp As Int32 = X
X = Y
Y = temp
End Sub
Info for maybe later use:
If the plot function returns true, the Bresenhams line routine continues.
if the plot function returns false, the algorithm stops
Delegate Function PlotFunction(ByVal x As Int32, ByVal y As Int32, ByVal colour As Color, ByVal gr As Graphics, ByVal ROP As Integer) As Boolean
Public Sub BresenhamLine(ByVal x1 As Int32, ByVal y1 As Int32, ByVal x2 As Int32, ByVal y2 As Int32, ByVal colour As Color, ByVal gr As Graphics)
Note- this needs modifying to do full length fancy dashed-dotted etc. iines
Hmmm it may occasionally leave small traces of artifacts on loaded images when erased - even though it shouldnt
Note: the line drawn here is deliberately NOT anti-aliased (so expect some stepping for diagonal lines)
Dim steep As Boolean = (Math.Abs(y2 - y1) > Math.Abs(x2 - x1))
If (steep) Then
Swap(x1, y1)
Swap(x2, y2)
End If
If (x1 > x2) Then
Swap(x1, x2)
Swap(y1, y2)
End If
Dim deltaX As Int32 = x2 - x1
Dim deltaY As Int32 = y2 - y1
Dim err As Int32 = CInt(CLng(deltaX / 2))
Dim ystep As Int32
Dim y As Int32 = y1
If (y1 < y2) Then
ystep = 1
Else
ystep = -1
End If
For x As Int32 = x1 To x2
If (steep) Then
plotPoint(y, x, colour, gr, 0)
Else
plotPoint(x, y, colour, gr, 0)
End If
Next
End Sub
Public Sub BresenhamCircle(ByVal centreX As Int32, ByVal centreY As Int32, ByVal radius As Int32, ByVal colour As Color, ByVal gr As Graphics)
Dim x As Int32 = 0, y As Int32 = radius
Dim d As Int32 = 3 - (2 * radius)
Draws a damned fast and good solid circle
Note that this IS suitable for use with flood-fills!!!!!!
Hmmm it may occasionally leave small traces of artifacts on loaded images when erased - even though it shouldnt
Draw 8 points at a time covering all four quadrants
While (y > x)
plotPoint(centreX + x, centreY + y, colour, gr, 0)
plotPoint(centreX + y, centreY + x, colour, gr, 0)
plotPoint(centreX - x, centreY + y, colour, gr, 0)
plotPoint(centreX + y, centreY - x, colour, gr, 0)
plotPoint(centreX - x, centreY - y, colour, gr, 0)
plotPoint(centreX - y, centreY - x, colour, gr, 0)
plotPoint(centreX + x, centreY - y, colour, gr, 0)
plotPoint(centreX - y, centreY + x, colour, gr, 0)
If (d < 0) Then
d += (4 * x) + 6
Else
d += (4 * (x - y)) + 10
y -= 1
End If
x += 1
End While
Make sure we draw the extreme points at top, bottom, left and right of the circle
plotPoint(centreX, centreY + radius, colour, gr, 0)
plotPoint(centreX, centreY - radius, colour, gr, 0)
plotPoint(centreX + radius, centreY, colour, gr, 0)
plotPoint(centreX - radius, centreY, colour, gr, 0)
End Sub
Public Sub Rectangle(ByVal x1 As Int32, ByVal y1 As Int32, ByVal x2 As Int32, ByVal y2 As Int32, ByVal colour As Color, ByVal gr As Graphics)
BresenhamLine(CInt(x1), CInt(y1), CInt(x2), CInt(y1), colour, gr) Draw a line between the points
BresenhamLine(CInt(x2), CInt(y1), CInt(x2), CInt(y2), colour, gr) Draw a line between the points
BresenhamLine(CInt(x2), CInt(y2), CInt(x1), CInt(y2), colour, gr) Draw a line between the points
BresenhamLine(CInt(x1), CInt(y2), CInt(x1), CInt(y1), colour, gr) Draw a line between the points
End Sub
Public Sub plotPoint(ByVal x As Int32, ByVal y As Int32, ByVal newcolour As Color, ByVal gr As Graphics, ByVal ROP As Integer)
Dim oldcolor As Color = DirectCast(Form1.PictureBox1.Image, Bitmap).GetPixel(x, y)
Note: ROP is passed as an integer - this is so that it will let me code other Raster Operations later
Try
Get the old colour
Dim oldcolour As Color = Form1.currentbitmap.GetPixel(x, y) Hmmm a bit too application specific here
Dim xorcolour As Color
Define variables to hold the xored values
Dim xa As Int32
Dim xr As Int32
Dim xg As Int32
Dim xb As Int32
Get the alpha, red, green, blue values of the old colour
Dim a1 As Int32 = oldcolour.A
Dim r1 As Int32 = oldcolour.R
Dim g1 As Int32 = oldcolour.G
Dim b1 As Int32 = oldcolour.B
Get the alpha, red, green, blue values of the new colour
Dim a2 As Int32 = newcolour.A
Dim r2 As Int32 = newcolour.R
Dim g2 As Int32 = newcolour.G
Dim b2 As Int32 = newcolour.B
Form1.OldColourToolStripStatusLabel.Text =oldcolour.Name Hmmm a bit too application specific here
What I evenually intend to do here is to read the colour already plotted and appy a Boolean logic operator on with the new colour
Note the messing about that we have to do in order to plot a single pixel in .Net
Dim bm As New Bitmap(1, 1) Create new bitmap of size(1x1 pixel)
Ok we have the old colour component values and the new color component values so do the raster op here
xor the components from both colours
xa = a1 We dont actually want to xor the alpha channels - well just leave that as is to preserve the transparency of the current bitmap
xr = (r1 Xor r2) xor the red components
xg = (g1 Xor g2) xor the green components
xb = (b1 Xor b2) xor the blue components
Plot the point
xorcolour = Color.FromArgb(xa, xr, xg, xb) Convert the xored components into a colour
bm.SetPixel(0, 0, xorcolour) Set that single pixel to the desired xored colour
gr.DrawImageUnscaled(bm, CInt(x), CInt
) Draw the single pixel bitmap onto the graphics objectbm.Dispose() Done with the 1x1 bitmap so dispose of it
Catch ex As Exception
MsgBox("Whoops!" & ex.Message)
Exit Sub
End Try
End Sub
End Module
View the full article