this is just an excuse for me to dump my code here. p.s. heckling will be ignored
p.s.: visual basic express is lol
... not really, because it's CLR/CIL, and CLR/CIL is halfway decent in my book. But, hey, whatever.
I'm still going to heckle you about it because you're always "ARRRRRRRRRRRRG LINE TERMINATORS" and "ARRRRRRRRRRRRRRG FORCED INDENTION" with regard to all other languages. :)
for some reason this fucker's pulling up an OpenDialog twice.
Dim fileName As String With OpenFileDialog1
.Filter = "JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|Bitmap (*.BMP)|*.BMP|All Files (*.*)|*.*"
.ShowDialog() If .ShowDialog = Windows.Forms.DialogResult.OK Then fileName = .FileName If fileName.Length <> 0 Then
Try
PictureBox1.ImageLocation = fileName
Catch ex As Exception End Try
End If
End Withthanks @ nitro for pointing out that .ShowDialog is a function that executes the form. N00b mistake. I can't ask for the result by showing the form again like this, so here's what the new code looks like. function for loading an image:
With OpenFileDialog1
.Filter = "JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|Bitmap (*.BMP)|*.BMP|All Files (*.*)|*.*"
DialogResult = .ShowDialog() If DialogResult = Windows.Forms.DialogResult.OK Then If .FileName.Length <> 0 Then
Try
PictureBox1.ImageLocation = .FileName
Catch ex As Exception End Try
End If
End If
End With' this is fixed 8)
' see if you can spot what was wrong
Dim fileName As StringWith OpenFileDialog1
.Filter = "JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|Bitmap (*.BMP)|*.BMP|All Files (*.*)|*.*" If .ShowDialog() = Windows.Forms.DialogResult.OK Then fileName = .FileName If fileName.Length <> 0 Then
Try
PictureBox1.ImageLocation = fileName
Catch ex As Exception End Try
End If
End WithSince using ImageLocation can also suck things from the web, a faster and more efficient way to load the image may be to use the following line:
PictureBox1.Image = New Bitmap(.FileName)
Here I've worked on some code to see how fast GDI+ can transform an image, and whether or not it is suitable for real-time image editing. I have a bug in the ScrollMatrix code where the matrix cascades in values, but I don't know how to fix it so the code accurately scrolls based on mouse position. The form contains two hscrollbars, one listbox, one button, and one picturebox. Bake at 350 degrees for 20 minutes.
Rotation, Translation, and Zoom Matrices
Public Class Form1
Dim mainBitmap As Bitmap
Dim ScrollMatrix As System.Drawing.Drawing2D.Matrix = New Drawing2D.Matrix
Dim PreviousScrollMatrix As System.Drawing.Drawing2D.Matrix = New Drawing2D.MatrixDim initialLocation As Point = New PointPrivate Sub cmdLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdLoad.Click With OpenFileDialog1
.Filter = "Images|*.gif;*.jpg;*.png;*.bmp|GIF (*.gif)|*.gif|JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|Bitmap (*.BMP)|*.BMP|All Files (*.*)|*.*"
DialogResult = .ShowDialog() If DialogResult = Windows.Forms.DialogResult.OK Then If .FileName.Length <> 0 Then
Try
mainBitmap = Image.FromFile(OpenFileDialog1.FileName)
PictureBox1.Invalidate()
Catch ex As Exception End Try
End If
End If
End WithEnd SubPrivate Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOkEnd SubPrivate Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ListBox1.SelectedIndex = 1
End SubPrivate Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
initialLocation = e.Location 'ScrollMatrix.Reset()
End SubPrivate Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove If e.Button = Windows.Forms.MouseButtons.Right Then
ScrollMatrix = PreviousScrollMatrix ScrollMatrix.Translate((e.X - initialLocation.X) / 10, (e.Y - initialLocation.Y) / 10)
PictureBox1.Invalidate()
End IfEnd SubPrivate Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
If e.Button = Windows.Forms.MouseButtons.Right Then PreviousScrollMatrix = ScrollMatrix
End SubRotation, Translation, and Zoom Matrices, Continued
Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint Select Case ListBox1.SelectedIndex
Case Is = 0
e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor
Case Is = 1
e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.Bilinear
Case Is = 2
e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.Bicubic
Case Is = 3
e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBilinear
Case Is = 4
e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
End Select 'paint bitmap to screen
If mainBitmap Is Nothing Then
Exit Sub
Else
Dim TransformationMatrix As System.Drawing.Drawing2D.Matrix = New Drawing2D.Matrix
Dim MidPoint As System.Drawing.PointF = New System.Drawing.PointF(mainBitmap.Width / 2, mainBitmap.Height / 2) TransformationMatrix.Multiply(ScrollMatrix) ' scroll the image to the proper position TransformationMatrix.Translate((PictureBox1.Width - (mainBitmap.Width * HScrollBar2.Value / 100)) / 2, (PictureBox1.Height - (mainBitmap.Height * HScrollBar2.Value / 100)) / 2, Drawing2D.MatrixOrder.Append)
TransformationMatrix.Scale(HScrollBar2.Value / 100, HScrollBar2.Value / 100)
TransformationMatrix.RotateAt(HScrollBar1.Value, MidPoint) 'changes the rotational value of the transformation matrix e.Graphics.Transform = TransformationMatrix 'transforms the image specified by our matrix previously defined e.Graphics.DrawImage(mainBitmap, 0, 0)
End If 'write stuff over the top
Dim fnt As Font = New Font("Arial", 16)
Try
e.Graphics.DrawString(PreviousScrollMatrix.OffsetX.ToString, fnt, Brushes.AliceBlue, 0, 0)
Catch ex As Exception
End TryEnd SubPrivate Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
PictureBox1.Invalidate()
End SubPrivate Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
PictureBox1.Invalidate()
End SubPrivate Sub HScrollBar1_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles HScrollBar1.Scroll
PictureBox1.Invalidate()
Me.Text = "Rotation angle: " & HScrollBar1.Value.ToString & "°, Zoom: " & HScrollBar2.Value.ToString & "%"
End SubPrivate Sub HScrollBar2_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles HScrollBar2.Scroll
PictureBox1.Invalidate()
Me.Text = "Rotation angle: " & HScrollBar1.Value.ToString & "°, Zoom: " & HScrollBar2.Value.ToString & "%"
End SubEnd Class
exe included in link. .NET framework 2.0 required. Comments and tips welcome
virusGET
Updated link and program. Figured out that setting one Matrix object in VBE to another kind of intertwines their destinies. Justified my hatred for OOP after switching to PointF objects. Fixed several other bugs.
more coming (maybe) soon.....
I wrote this next one to test interpolation modes for fixing the problem tablet users have when they make brush strokes too fast. This experiment was also the beginnings of an Event file format like PaintBBS/oC which lets you recreate an entire drawing from individual strokes. Indispensible for vector-style resizing or rotating, and online transmission. For this, you'll need 3 checkboxes, an hscrollbar, and a listbox.
Linear and Spline interpolation
Dim DrawPoints(1) As Point
Dim TempSurface As Bitmap = New Bitmap(800, 600)
Dim g As Graphics = Graphics.FromImage(TempSurface)
Dim MyPoints(0) As PointPrivate Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.LoadEnd SubPrivate Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
ReDim MyPoints(0)
ListBox1.Items.Clear() g.Clear(Color.Black)
Me.Invalidate()
End SubPrivate Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim CurrentPoint As Point
CurrentPoint = Me.PointToClient(Windows.Forms.Cursor.Position) Debug.WriteLine("X = " & CurrentPoint.X & ", " & CurrentPoint.Y) With MyPoints(MyPoints.GetUpperBound(0)) 'Fill the current index with the cursor point
.X = e.X
.Y = e.Y
End With
ReDim Preserve MyPoints(MyPoints.GetUpperBound(0) + 1) 'Extend the array one more index Me.Invalidate() End If
End SubPrivate Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp Dim x As Integer
For x = 0 To MyPoints.GetUpperBound(0)
ListBox1.Items.Add(MyPoints(x))
Next g.Clear(Color.Black)
Me.Invalidate()
End SubDon't forget to check the link for a precompiled exe (don't run unless you're sure it's safe).
Linear and Spline interpolation, Continued
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint Dim rpen, bpen, ppen As Pen
rpen = New Pen(Color.FromArgb(255, 255, 0, 0), HScrollBar1.Value)
bpen = New Pen(Color.FromArgb(255, 0, 0, 255), HScrollBar1.Value)
ppen = New Pen(Color.FromArgb(255, 0, 255, 0), HScrollBar1.Value * 2) Dim x As Integer If CheckBox2.Checked = True Then
If MyPoints.GetUpperBound(0) > 1 Then
For x = 0 To MyPoints.GetUpperBound(0) - 2
g.DrawLine(rpen, MyPoints(x), MyPoints(x + 1))
Next
End If
End If If CheckBox3.Checked = True Then
Dim TempPts() As Point = MyPoints.Clone
ReDim Preserve TempPts(TempPts.GetUpperBound(0) - 1)
If MyPoints.GetUpperBound(0) > 1 Then g.DrawCurve(bpen, TempPts)
End If If CheckBox1.Checked = True Then
For x = 0 To MyPoints.GetUpperBound(0) - 1
g.DrawEllipse(ppen, MyPoints(x).X, MyPoints(x).Y, 1, 1)
Next
End If e.Graphics.DrawImage(TempSurface, 0, 0)
End SubPrivate Sub CheckBox1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged
g.Clear(Color.Black)
Me.Invalidate()
End SubPrivate Sub CheckBox2_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox2.CheckedChanged
g.Clear(Color.Black)
Me.Invalidate()
End SubPrivate Sub CheckBox3_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox3.CheckedChanged
g.Clear(Color.Black)
Me.Invalidate()
End SubPrivate Sub HScrollBar1_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles HScrollBar1.Scroll
g.Clear(Color.Black)
Me.Invalidate()
End SubAll the CAPS in these code snaps make me think of FORTRAN.
Besides, what was the point of this thread again?
makin' stuff, hopefully starting a discussion with a wayward VBE user regarding stuff other than databases and boring business crap
Here is my MP3 and mod parsing code being used in new radio station
Private Function Parse(ByVal filename As String)
Artist = ""
SongName = "" Try Dim preparedFile As String 'juicy and fixed file
Dim fileArray() As String 'chop off everything but the end, replace underscores with spaces, and spaces with dash delimiters into an asterisk.
preparedFile = filename.Substring(0, filename.LastIndexOf(".")).Remove(0, filename.LastIndexOf("\") + 1).Replace("_", " ").Replace(" - ", "*") fileArray = preparedFile.Split("*") 'Try splitting files with spaces. Select Case fileArray.Length 'Token Length Descision tree Case Is = 1 'Probably a mod or other short filename.
fileArray = preparedFile.Split("-") 'Try splitting files without spaces in the dash. (less predictable) Select Case fileArray.Length 'Second Try
Case Is = 1 'Probably a mod or other short filename. Try one more time to get the file.
'If filename.EndsWith(".mp3") = True Then Set Artist = ID3 tag. SongName = preparedFile
Case Is = 2 ' Probably an artist and songname. Check to make sure first value isn't a track number.
If Integer.TryParse(fileArray(0), Nothing) Then 'First token's a track number. Check ID3 tags.
'MsgBox("Track number.")
Else
Artist = fileArray(0) End If Case Is = 3 'Probably an artist, a track number / album number, and a songname.
If Val(fileArray(0)) > 0 Then Artist = fileArray(1) Else Artist = fileArray(0)
SongName = fileArray(2) Case Is > 3 'Something else.
SongName = preparedFile End Select
Case Is = 2 ' Probably an artist and songname. Check to make sure first value isn't a track number.
If Integer.TryParse(fileArray(0), Nothing) Then 'First token's a track number. Check ID3 tags.
'MsgBox("Track number.")
Else
Artist = fileArray(0) End If
SongName = fileArray(1) Case Is = 3 'Probably an artist, a track number / album number, and a songname.
If Val(fileArray(0)) > 0 Then Artist = fileArray(1) Else Artist = fileArray(0)
SongName = fileArray(2) Case Is > 3 'Something else.
SongName = preparedFile Case Else End Select Return True Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
Return False
End TryEnd FunctionBugfix for MP3/mod parser. Admin, please delete previous post...
Private Function Parse(ByVal filename As String)
Artist = ""
SongName = "" Try Dim preparedFile As String 'juicy and fixed file
Dim fileArray() As String 'chop off everything but the end, replace underscores with spaces, and spaces with dash delimiters into an asterisk.
preparedFile = filename.Substring(0, filename.LastIndexOf(".")).Remove(0, filename.LastIndexOf("\") + 1).Replace("_", " ").Replace(" - ", "*") fileArray = preparedFile.Split("*") 'Try splitting files with spaces. Select Case fileArray.Length 'Token Length Descision tree Case Is = 1 'Probably a mod or other short filename.
fileArray = preparedFile.Split("-") 'Try splitting files without spaces in the dash. (less predictable) Select Case fileArray.Length 'Second Try
Case Is = 1 'Probably a mod or other short filename. Try one more time to get the file.
'If filename.EndsWith(".mp3") = True Then Set Artist = ID3 tag. SongName = preparedFile
Case Is = 2 ' Probably an artist and songname. Check to make sure first value isn't a track number.
If Integer.TryParse(fileArray(0), Nothing) Then 'First token's a track number. Check ID3 tags.
'MsgBox("Track number.")
Else
Artist = fileArray(0) End If Case Is = 3 'Probably an artist, a track number / album number, and a songname.
If Integer.TryParse(fileArray(0), Nothing) Then Artist = fileArray(1) Else Artist = fileArray(0)
SongName = fileArray(2) Case Is > 3 'Something else.
SongName = preparedFile End Select
Case Is = 2 ' Probably an artist and songname. Check to make sure first value isn't a track number.
If Integer.TryParse(fileArray(0), Nothing) Then 'First token's a track number. Check ID3 tags.
'MsgBox("Track number.")
Else
Artist = fileArray(0) End If
SongName = fileArray(1) Case Is = 3 'Probably an artist, a track number / album number, and a songname.
If Integer.TryParse(fileArray(0), Nothing) Then Artist = fileArray(1) Else Artist = fileArray(0)
SongName = fileArray(2) Case Is > 3 'Something else.
SongName = preparedFile Case Else End Select Return True Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
Return False
End TryEnd Functionbahhhhhhhh another bug. Where the fuck is the delete option on this page?
It was removed so that people think before they post.
Why don't you put the code on a wiki or something and link to it?
Or use a service like pastebin, or some such. They've got syntax highlighting and all.
a programming board that encourages the wakabamark code option not be used to its fullest potential, that's a new one :B
Though pastebin sounds interesting..... it's damned slow though