Option Explicit On
Option Compare Text
Public Class XtremePhoto
Dim graphics1 As Graphics
Dim savebkimage As String = "c:\xtremephoto\backimage.jpg"
Dim saveForeimage As String = "c:\xtremephoto\Foreimage.jpg"
Dim CMdefaults() As Single = {100, 0, 0, 0, 0, 0, 100, 0, 0, 0, 0, 0, 100, 0, 0, 0, 0, 0, 100, 0, 0, 0, 0, 0, 100}
Dim CMset() As Single = {100, 0, 0, 0, 0, 0, 100, 0, 0, 0, 0, 0, 100, 0, 0, 0, 0, 0, 100, 0, 0, 0, 0, 0, 100}
Dim CMUse As Single()() = { _
New Single() {100, 0, 0, 0, 0}, _
New Single() {0, 100, 0, 0, 0}, _
New Single() {0, 0, 100, 0, 0}, _
New Single() {0, 0, 0, 100, 0}, _
New Single() {0, 0, 0, 0, 100}}
Private Sub XtremePhoto_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Me.PictureBox1.Image = New Bitmap(saveForeimage)
Me.PictureBox2.Image = New Bitmap(saveForeimage)
Me.PictureBox3.Image = New Bitmap(savebkimage)
Me.PictureBox3.BackColor = Color.Black
setdefaults()
End Sub
Private Sub ApplySettings_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ApplySettings.Click
doapplysettings()
End Sub
Private Sub doapplysettings()
buildColorMatrix()
Dim x As Integer
Dim y As Integer
Dim i As Integer = 0
For x = 0 To 4
For y = 0 To 4
Dim name = "trackbar" & i
CMUse(x)(y) = Me.Controls.Item(name).value / 100
i = i + 1
Next
Next
doRGBcolorGDI(CMUse)
End Sub
Public Sub doRGBcolorGDI(ByRef mxitems)
Me.PictureBox2.Image = New Bitmap(Me.PictureBox1.Image)
Me.PictureBox3.Image = New Bitmap(savebkimage)
Dim colorMatrix As New System.Drawing.Imaging.ColorMatrix(mxitems)
' Create an ImageAttributes object and set its color matrix.
Dim imageAtt As New System.Drawing.Imaging.ImageAttributes()
imageAtt.SetColorMatrix(colorMatrix, System.Drawing.Imaging.ColorMatrixFlag.Default, System.Drawing.Imaging.ColorAdjustType.Bitmap)
imageAtt.SetColorKey(System.Drawing.Color.Black, System.Drawing.Color.White)
Dim calcG As Single = CSng(Val(Me.Gamma.Value) / 50)
imageAtt.SetGamma(calcG, System.Drawing.Imaging.ColorAdjustType.Bitmap)
If Me.Threshold.Value <> 500 Then
calcG = CSng(Val(Me.Threshold.Value) / 1000)
imageAtt.SetThreshold(calcG, System.Drawing.Imaging.ColorAdjustType.Bitmap)
End If
Dim r1 As RectangleF
r1.X = 0
r1.Y = 0
r1.Width = Me.PictureBox2.Image.Width
r1.Height = Me.PictureBox2.Image.Height
Dim r2 As RectangleF
r2.X = 0
r2.Y = 0
r2.Width = Me.PictureBox2.Image.Width
r2.Height = Me.PictureBox2.Image.Height
'
graphics1 = Graphics.FromImage(Me.PictureBox2.Image)
Dim brush3 As New TextureBrush(Me.PictureBox1.Image, r1, imageAtt)
graphics1.FillRectangle(brush3, r2)
r1.X = 0
r1.Y = 0
r1.Width = Me.PictureBox2.Image.Width
r1.Height = Me.PictureBox2.Image.Height
r2.X = 0
r2.Y = 0
r2.Width = Me.PictureBox3.Image.Width
r2.Height = Me.PictureBox3.Image.Height
graphics1.Dispose()
graphics1 = Graphics.FromImage(Me.PictureBox3.Image)
imageAtt.SetColorMatrix(colorMatrix, System.Drawing.Imaging.ColorMatrixFlag.Default, System.Drawing.Imaging.ColorAdjustType.Bitmap)
imageAtt.SetColorKey(System.Drawing.Color.Black, System.Drawing.Color.White)
Dim brush4 As New TextureBrush(Me.PictureBox1.Image, r1, imageAtt)
graphics1.FillRectangle(brush3, r2)
brush3.Dispose()
brush4.Dispose()
graphics1.Dispose()
End Sub
Private Sub buildColorMatrix()
Dim gottip As String
Dim x As Integer = 0
Try
again:
For x = 0 To Me.Controls.Count - 1
gottip = Me.Controls.Item(x).ToString & "," & Me.Controls.Item(x).Name & ","
If gottip Like "*trackBar*" Then
gottip = Replace(gottip, ": ", "=")
gottip = Replace(gottip, "Trackbar", "", 1, 1, CompareMethod.Text)
gottip = Replace(gottip, "Trackbar", "Trackbar=")
Dim name = "trackbar" & CStr(getarg2(gottip, "Trackbar"))
CMset(getarg2(gottip, "Trackbar")) = Me.Controls.Item(name).value
End If
Next
Catch
x = x + 1
GoTo again
End Try
Dim ln As Integer = 0
ShowCM.Text = ""
For x = 0 To 24
ln = ln + 1
Dim name = "trackbar" & x
Dim sn As Single = Me.Controls.Item(name).value
ShowCM.Text = ShowCM.Text & sn / 100 & ","
If ln = 5 Then ShowCM.Text = ShowCM.Text & vbCrLf : ln = 0
Next
End Sub
Private Sub setdefaults()
Dim gottip As String
Dim x As Integer = 0
Gamma.Value = 50
Me.Threshold.Value = 500
'Try
again:
For x = 0 To Me.Controls.Count - 2
gottip = Me.Controls.Item(x).ToString & "," & Me.Controls.Item(x).Name & ","
If gottip Like "*trackBar*" Then
gottip = Replace(gottip, ": ", "=")
gottip = Replace(gottip, "Trackbar", "", 1, 1, CompareMethod.Text)
gottip = Replace(gottip, "Trackbar", "Trackbar=")
Dim name = "trackbar" & CStr(getarg2(gottip, "Trackbar"))
Me.Controls.Item(name).value = CMdefaults(getarg2(gottip, "Trackbar"))
End If
Next
'Catch
'x = x + 2
'GoTo again
'End Try
Dim ln As Integer = 0
ShowCM.Text = ""
For x = 0 To 24
ln = ln + 1
Dim name = "trackbar" & x
Dim sn As Single = Me.Controls.Item(name).value
ShowCM.Text = ShowCM.Text & sn / 100 & ","
If ln = 5 Then ShowCM.Text = ShowCM.Text & vbCrLf : ln = 0
Next
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
setdefaults()
Me.PictureBox1.Image = New Bitmap(saveForeimage)
Me.PictureBox2.Image = New Bitmap(saveForeimage)
Me.PictureBox3.Image = New Bitmap(savebkimage)
doapplysettings()
End Sub
Private Sub GetMage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GetMage.Click
On Error Resume Next
Me.OpenFileDialog1.ShowDialog()
savebkimage = Me.OpenFileDialog1.FileName
Me.PictureBox3.Image = New Bitmap(Me.OpenFileDialog1.FileName)
End Sub
Private Sub GetForeImage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GetForeImage.Click
Me.OpenFileDialog1.ShowDialog()
saveForeimage = Me.OpenFileDialog1.FileName
Me.PictureBox1.Image = New Bitmap(Me.OpenFileDialog1.FileName)
End Sub
Private Sub GrayScale_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GrayScale.Click
Dim cm As New System.Drawing.Imaging.ColorMatrix(New Single()() _
{New Single() {0.299, 0.299, 0.299, 0, 0}, _
New Single() {0.587, 0.587, 0.587, 0, 0}, _
New Single() {0.114, 0.114, 0.114, 0, 0}, _
New Single() {0, 0, 0, 1, 0}, _
New Single() {0, 0, 0, 0, 1}})
Dim x As Integer
Dim y As Integer
Dim i As Integer = 0
For x = 0 To 4
For y = 0 To 4
Dim name = "trackbar" & i
Me.Controls.Item(name).value = cm(x, y) * 100
i = i + 1
Next
Next
doapplysettings()
End Sub
Private Sub Gamma_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Gamma.Scroll
Me.PictureBox2.Image = New Bitmap(saveForeimage)
Me.PictureBox3.Image = New Bitmap(savebkimage)
Dim imageAtt As New System.Drawing.Imaging.ImageAttributes()
Dim calcG As Single = CSng(Val(Me.Gamma.Value) / 50)
imageAtt.SetGamma(calcG, System.Drawing.Imaging.ColorAdjustType.Bitmap)
Dim r1 As RectangleF
r1.X = 0
r1.Y = 0
r1.Width = Me.PictureBox1.Image.Width
r1.Height = Me.PictureBox1.Image.Height
Dim r2 As RectangleF
r2.X = 0
r2.Y = 0
r2.Width = Me.PictureBox2.Image.Width
r2.Height = Me.PictureBox2.Image.Height
'
graphics1 = Graphics.FromImage(Me.PictureBox2.Image)
Dim brush3 As New TextureBrush(Me.PictureBox1.Image, r1, imageAtt)
graphics1.FillRectangle(brush3, r2)
'
doapplysettings()
End Sub
Private Sub Threshold_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Threshold.Scroll
Me.PictureBox2.Image = New Bitmap(saveForeimage)
Me.PictureBox3.Image = New Bitmap(savebkimage)
' Create an ImageAttributes object and set its color matrix.
Dim imageAtt As New System.Drawing.Imaging.ImageAttributes()
Dim calcG As Single = CSng(Val(Me.Threshold.Value) / 1000)
imageAtt.SetThreshold(calcG, System.Drawing.Imaging.ColorAdjustType.Bitmap)
Dim r1 As RectangleF
r1.X = 0
r1.Y = 0
r1.Width = Me.PictureBox1.Image.Width
r1.Height = Me.PictureBox1.Image.Height
Dim r2 As RectangleF
r2.X = 0
r2.Y = 0
r2.Width = Me.PictureBox2.Image.Width
r2.Height = Me.PictureBox2.Image.Height
'
graphics1 = Graphics.FromImage(Me.PictureBox2.Image)
Dim brush3 As New TextureBrush(Me.PictureBox1.Image, r1, imageAtt)
graphics1.FillRectangle(brush3, r2)
doapplysettings()
End Sub
Private Sub DoGamma_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DoGamma.Click
Gamma.Value = 50
doapplysettings()
End Sub
Private Sub DoThreshold_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DoThreshold.Click
Threshold.Value = 500
End Sub
Private Function getarg2(ByRef aarg As String, ByRef p As String) As String
aarg = aarg & ","
Dim ll, ptr, ap As Object
Dim comma As Long
Dim results As String
ll = 0
ptr = InStr(aarg, p)
If ptr = 0 Then
results = 0
GoTo exit1
End If
ptr = ptr + Len(p) + 1
ap = Mid(aarg, ptr, Len(aarg))
comma = InStr(ap, ",")
results = Mid(ap, 1, comma - 1)
exit1:
getarg2 = results
End Function
Private Sub SavePic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SavePic.Click
Me.SaveFileDialog1.ShowDialog()
Me.PictureBox3.Image.Save(SaveFileDialog1.FileName)
End Sub
End Class
Submit an article or tip