Hello!
I had promissed in a former tutorial that I was going to fiddle some more with the code of Rick Van Den Bosch at:
http://bloggingabout...05/10/3830.aspx
to encode gif animations.
Well, I did and this program is what I have to offer you now.
It is the merging of two utilities I created before for extracting frames from a Gif animation and to assemble them again.
With this program you could assemble your own gifs or you could extract the frames of an existing gif to various different image formats and to manipulate them on various ways. After modifying them, you could create a new animation.
The different manipulations you can perform on the images we have:
Resizing: 25%, 33%, 50%, 75%, 150% And 200%
Reverting Movement
Cropping Rectangular Areas
Flipping Right To Left And Left To right
Converting To Gray Scale
Converting To Sepia Tone
Changing Intensity
Making Slide Show
Getting Edges
Deleting Some Frames
Selecting A Range Of Frames
Joining Two Or More Animations
And probably you would like to add your own.
At startup most of the controls and setting are dissabled to avoid accidental errors. These controls are enabled
when you disassemble an animation.
Most of the operations are done accessing the images extracted to disk. I selected the jpeg format, because the indexed ones give problems on further processing, the old history "Graphics can not be created from indexed..."
Besides, to process everything in memory requieres the use of byte arrays on certain instances to store bitmaps on memory streams and can not be used directly without more transformations. I make use of a memory stream to save the image on gif format without accessing the disk, but is a small operation on individual files. A large image, long gif animation take a lot of memory, depending on the amount of frames, that could be few hundreds.
Due to the jpeg selection, my program is set to scan the folder for jpg images, on the option of reading everything to select a new group of files to assemble.
The opening screen has a small animation that you can process, but in order to do so, you have to extract the frames. You could also open another gif file from your computer, and the same applies to it.
I have tried different ideas during the creation of this program, so my code may be redundant and buggy, so please feedback if you note something.
The controls on top and left are contained in frames, so it makes it easy to enable o disable them, enabling and disabling the frame, instead of the individual controls.
Here I will introduce a small warning: When you are playing with this program, checking different option, a large group of files are created in the output directory, so, you might need to check and delete the ones you no longer need.
Ok, here is the description of the different commands:
Form load creates the tooltips and loads the combobox that gives the type of image that is going to result from the extraction of the frames. The default is ".jpg". Also from the beginning you have the default name to use for the extraction files. To this prefix we will append a sequence of numbers, generated from a function that checks for existing filenames in the directory. The default is "Frame" So if there are no jpg files with this name, the first frame will be extracted with the name: Frame0000.jpg, the next one with Frame0001.jpg and so on.
Imports System.Collections.Generic
Imports System.Text
Imports System.IO
Imports System.Collections
Imports System.Collections.Specialized
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System
Imports System.Drawing.Drawing2D
Imports System.Drawing.Image
Imports System.Threading
Public Class BatchCrop
Dim OriginalGif As Image
Dim NameToUse As String = "Frame"
Dim ImgForSepia As Image
Dim W, H As Integer
Dim ImageArray, MemPic, WorkAry As New ArrayList
Dim N As Integer = 0
Dim Start, Finish As Integer 'For Selecting A Range Of Frames
Dim InitX As Integer = 0 'Top Left corner of crop
Dim InitY As Integer = 0
Dim Pictures As Integer = 0 'Frames Counter
'bitmap to contain the cropped image
Dim cropBitmap As Bitmap
Dim Im As Image 'Splash
'the position and size to crop the image file
Dim Xcropping As Integer
Dim Ycropping As Integer
Dim CroppingW As Integer
Dim CroppingH As Integer
Dim XStretching As Double = 1
Dim YStretching As Double = 1
Dim rect As Rectangle
'create a pen object
Public Marker As Pen
Dim NewName As String
'select a default crop line size
Public MarkerSize As Integer = 2
'will contain the dashStyle of the pen
Public crpStyle As Drawing2D.DashStyle = Drawing2D.DashStyle.Solid
'set a default crop line color
Public MarkerColor As Color = Color.Red
Dim tt As New ToolTip
Dim WasAnError As Boolean = False
Private _numberPreviewImages As Integer = 100
Private _imageSize As Integer = 100 '75
Dim Position As Integer = 0 'Where Are We On ImageArray When Clicking A Cell
Private Sub Form1_Load1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
tt.ShowAlways = True
tt.AutoPopDelay = 3000
tt.InitialDelay = 1000
tt.ReshowDelay = 2000
tt.SetToolTip(ckSlide, "When Checked Assembles Animation" & vbNewLine & "With Long Delay As Slide Show")
tt.SetToolTip(ckFlip, "Flips Images Around Vertical Axis")
tt.SetToolTip(ckGhost, "When Checked, Intends To Get The Edges Of The Images," & vbNewLine & "Works
Together With The Tracklbar Below It." & vbNewLine & "WARNING, It's Very Slow!!!")
tt.SetToolTip(ckJoin, "Joins Two Or More Animations. Please Check For Dimensions. The Frame Size" &
vbNewLine & "Is Determined By First Gif And The Others Will Be Padded Or Clipped")
tt.SetToolTip(ckDark, "Lightens Or Darkens Images")
tt.SetToolTip(rbNormal, "When Checked Images Mantain Original Color, Except For Ghost")
tt.SetToolTip(rbGrayScale, "When Checked, Inmages Are Changed To Grayscale")
tt.SetToolTip(rbSepiaTone, "When Checked, Inmages Are Changed To Sepia Shades")
tt.SetToolTip(btnExtract, "Click To Extract Frames" & vbNewLine & "And Enable Controls")
tt.SetToolTip(tbTolerance, "Works Witth CheckBox Above, & vbnewline" & "To Set Tolerance On Edge
Detection")
tt.SetToolTip(btnAnimate, "Assembles Images To Gif Animation" & vbNewLine & "Same Size, But With Settings
Above")
tt.SetToolTip(btnReverse, "Reverses Motion")
tt.SetToolTip(btnCrop, "Crops The Rectangular Area" & vbNewLine & "Selected With Mouse On PictureBox1," &
vbNewLine & "Repeats For All The Other Frames" & vbNewLine & "Assembles Animation")
tt.SetToolTip(btn75, "Resizes To 75% The Animation")
tt.SetToolTip(btn50, "Resizes Animation To 50%")
tt.SetToolTip(btn33, "Resizes Animation To 33%")
tt.SetToolTip(btn25, "Resizes Animation To 25%")
tt.SetToolTip(btn150, "Resizes Animation To 150%")
tt.SetToolTip(btn200, "Resizes Animation To 200%")
tt.SetToolTip(btnBack, "View Former Frame")
tt.SetToolTip(btnForward, "View Next Frame")
tt.SetToolTip(btnStart, "Start Selection For A Subset Of Images")
tt.SetToolTip(btnEnd, "Last Image Of Subset Selection")
tt.SetToolTip(btnDelete, "Eliminate This Frame From Animation")
tt.SetToolTip(lblTour, "Frame Sequence")
tt.SetToolTip(lbOutput, "Name Of Animation Generated")
tt.SetToolTip(lblInfo, "Information On Image Cropping")
tt.SetToolTip(cbType, "Select Extract File Type")
tt.SetToolTip(tbName, "Type Name Prefix")
tt.SetToolTip(btnForward, "Call Crop And Resizing Form")
tt.SetToolTip(btnCrop, "Extract Frames To Image Files")
tt.SetToolTip(tbName, "Imput Base Name For Your Generated Images")
tt.SetToolTip(plDoIt, "WARNING! When Playing With These Buttons" & vbNewLine & "Yo Will Generate Several
Files In Your Output Folder.")
tt.BackColor = Color.AliceBlue
' tt.ForeColor = Color.Red
cbType.Items.Add(".Bmp")
cbType.Items.Add(".Gif")
cbType.Items.Add(".Jpg")
cbType.Items.Add(".Png")
cbType.Items.Add(".Tif")
ImageArray = New ArrayList
MemPic = New ArrayList
cbType.SelectedIndex = 2
OriginalGif = pbSelect.Image
End Sub
From Here you can load a file or use the animation on the picturebox:
Private Sub OpenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles
OpenToolStripMenuItem.Click
Dim f As New OpenFileDialog
Try
With f
.Filter = "Gif Files|*.gif"
If .ShowDialog = DialogResult.OK Then
OriginalGif = Image.FromFile(.FileName)
pbPreview.Image = Image.FromFile(.FileName)
If ImageArray IsNot Nothing Then
If ckJoin.Checked = False Then ImageArray.Clear() 'For joining
End If
plDoIt.Enabled = False
plSelect.Enabled = False
N = 0
Me.Text = "Gif Processor -> " & .FileName.Substring(.FileName.LastIndexOf("\") + 1)
End If
End With
Catch ex As Exception
MessageBox.Show(ex.ToString)
Finally
If Not f Is Nothing Then
f.Dispose()
f = Nothing
End If
End Try
pbPreview.Visible = True
pbSelect.Visible = False
pbPreview.BringToFront()
End Sub
This will put the animation on pbPreview.
The other menu items are "Scan Folder" and "View Directory" (No Naming Convention) and "Exit". The first one will load all the names of the jpg files in the application initial directory. The second will open a Windows Explorer view of the folder. You figure out what exit stands for.
When you have a file loaded, you can select a file format and a default name from the options enabled. you will press the button "Extract Frames", that will enable the other options and extract the frames that form the animation.
Private Sub btnExtract_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles
btnExtract.Click
Rip(NameToUse)
pbPreview.Visible = False
pbSelect.Visible = True
pbSelect.Image = Image.FromFile(ImageArray(0))
plDoIt.Enabled = True
plSelect.Enabled = True
lblImages.Text = "Frames In Animation: " & ImageArray.Count.ToString
LoadImages()
End Sub
That will call the "Rip" and the "LoadImages" subroutines:
Public Sub Rip(ByVal Prefix As String)
ImageArray.Clear()
Dim Picture As Image
MemPic.Clear()
Dim MS As MemoryStream
Dim Buf As Byte()
Dim TempName As String
Dim oDimension As New FrameDimension(OriginalGif.FrameDimensionsList(0))
Dim FrameCount As Integer = OriginalGif.GetFrameCount(oDimension)
' Dim MemStr As Bitmap
For i As Integer = 0 To FrameCount - 1
OriginalGif.SelectActiveFrame(oDimension, i)
MS = New MemoryStream
Using Frames As New Bitmap(OriginalGif)
TempName = GetNewName(Prefix, ComboBox1.Text)
ImageArray.Add(TempName)
Frames.Clone.Save(MS, ImageFormat.Jpeg)
Buf = MS.ToArray
Picture = BytesToBitmap(Buf)
MemPic.Add(Picture)
MS.SetLength(0)
Select Case Trim(ComboBox1.Text.ToUpper)
Case ".BMP"
Frames.Save(GetNewName(Prefix, ComboBox1.Text), ImageFormat.Bmp)
Case ".JPG"
Frames.Save(GetNewName(Prefix, ComboBox1.Text), ImageFormat.Jpeg)
Case ".GIF"
Frames.Save(GetNewName(Prefix, ComboBox1.Text), ImageFormat.Gif)
Case ".PNG"
Frames.Save(GetNewName(Prefix, ComboBox1.Text), ImageFormat.Png)
Case ".TIF"
Frames.Save(GetNewName(Prefix, ComboBox1.Text), ImageFormat.Tiff)
End Select
End Using
Next
End Sub
This Will disassemble the loaded animation. Now we have in place our images to work with. The preview picturebox will disapear and the first frame will appear on "pbSelect". It is a still image.
The LoadImages subroutine will create the grid on the datagridview and load all the extracted frames from the animation:
Private Sub LoadImages()
Try
If ImageArray Is Nothing Then
Return
End If
If Me.WindowState = FormWindowState.Minimized Then
Return
End If
Me.Cursor = Cursors.WaitCursor
dataVImages.Rows.Clear()
dataVImages.Columns.Clear()
Dim ColumnsThatFit As Integer = (dataVImages.Width - 10) / (_imageSize + 25)
Dim numRows As Integer = 0
Dim ImagesToDisplay As Integer = ImageArray.Count
numRows = CInt(Math.Ceiling(CDbl(ImageArray.Count) / CDbl(ColumnsThatFit)))
Dim CellsForPictureNumber As Integer = numRows * ColumnsThatFit
' MessageBox.Show(ColumnsThatFit.ToString & "," & numRows.ToString & "," &
CellsForPictureNumber.ToString)
' Dynamically create the columns
For index As Integer = 0 To ColumnsThatFit - 1
Dim dataGridViewColumn As New DataGridViewImageColumn()
dataVImages.Columns.Add(dataGridViewColumn)
dataVImages.Columns(index).Width = _imageSize + 20
Next
' Create the rows
For index As Integer = 0 To numRows - 1
dataVImages.Rows.Add()
dataVImages.Rows(index).Height = _imageSize + 20
Next
Dim columnIndex As Integer = 0
Dim rowIndex As Integer = 0
For index As Integer = 0 To (ImagesToDisplay - 1)
' Load the image from the file and add to the DataGridView
Dim image As Image = Helper.ResizeImage(ImageArray(index), _imageSize, _imageSize, False)
dataVImages.Rows(rowIndex).Cells(columnIndex).Value = image
dataVImages.Rows(rowIndex).Cells(columnIndex).ToolTipText = "Frame-" & index.ToString & ": " &
Path.GetFileName(ImageArray(index)) & " " & GetImageWidth(ImageArray(index)) & "x" & GetImageHeight(ImageArray
(index))
' Have we reached the end column? if so then start on the next row
If columnIndex = ColumnsThatFit - 1 Then
rowIndex += 1
columnIndex = 0
Else
columnIndex += 1
End If
Next
' Blank the unused cells
If CellsForPictureNumber > ImagesToDisplay Then
For index As Integer = 0 To CellsForPictureNumber - ImagesToDisplay - 1
Dim dataGridViewCellStyle As New DataGridViewCellStyle()
dataGridViewCellStyle.NullValue = Nothing
dataGridViewCellStyle.Tag = "BLANK"
dataVImages.Rows(rowIndex).Cells(columnIndex + index).Style = dataGridViewCellStyle
Next
End If
Catch ex As Exception
Console.WriteLine(ex)
End Try
Me.Cursor = Cursors.Default
End Sub
If you press the chevrons left or right you could cycle through the different frames, forward or reverse. The name and number will appear on the label.
Private Sub btnForward_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles
btnForward.Click
'View Jpg Files in Directory
If ImageArray.Count = 1 Then Exit Sub
N += 1
If N > ImageArray.Count - 1 Then
N = 0
End If
If ImageArray(N) IsNot Nothing Then
pbSelect.Image = Image.FromFile(ImageArray(N))
End If
lblTour.Text = ImageArray(N) & vbNewLine & "Image(" & N & ")"
Hilite()
End Sub
Private Sub btnBack_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBack.Click
'View Jpg Files in Directory
If ImageArray.Count = 1 Then Exit Sub
N = N - 1
If N < 0 Then
N = ImageArray.Count - 1
End If
If ImageArray(N) IsNot Nothing Then
pbSelect.Image = Image.FromFile(ImageArray(N))
End If
lblTour.Text = ImageArray(N) & vbNewLine & "Image(" & N & ")"
Hilite()
End Sub
And the corresponding frame will be highlighted on the datagridview.
If you click an image on the datagridview or when it has the focus and you press the arrow up, down, left or right, you would navigate the frames and the picturebox will be updated. Here the selections won't go past the last one or before the first one, but with the chevrons you will start again on the other end if you go past the end or the beginning.
This naavigation is controlled whith these routines make the rows and columns match the ImageArray Index and count:
Private Sub dataVImages_CellClick(ByVal sender As Object, ByVal e As
System.Windows.Forms.DataGridViewCellEventArgs) Handles dataVImages.CellClick
'Select Frame By Using Mouse
Dim i, j As Integer
i = e.RowIndex
j = e.ColumnIndex
Position = i * dataVImages.Columns.Count + j ' + 1 'index of imagearray
If Position > ImageArray.Count - 1 Then Exit Sub
pbSelect.Image = Image.FromFile(ImageArray(Position))
lblTour.Text = ImageArray(Position) & vbNewLine & "Image(" & Position & ")"
N = Position
Refresh()
End Sub
Private Sub Hilite()
Dim rcol, rrow As Integer
rcol = N Mod dataVImages.Columns.Count
' rrow = N / dataVImages.Columns.Count
rrow = CInt(Math.Ceiling(CDbl(N + 1) / CDbl(dataVImages.Columns.Count))) - 1
dataVImages.CurrentCell = dataVImages(rcol, rrow)
dataVImages.BeginEdit(True)
' MessageBox.Show("Col " & rcol.ToString & " Row " & rrow.ToString)
End Sub
Private Sub dataVImages_CellEnter(ByVal sender As Object, ByVal e As
System.Windows.Forms.DataGridViewCellEventArgs) Handles dataVImages.CellEnter
'Select Frame By Using Arrows
Dim i, j As Integer
i = e.RowIndex
j = e.ColumnIndex
Position = i * dataVImages.Columns.Count + j ' + 1 'index of imagearray
If Position > ImageArray.Count - 1 Then Exit Sub
pbSelect.Image = Image.FromFile(ImageArray(Position))
lblTour.Text = ImageArray(Position) & vbNewLine & "Image(" & Position & ")"
N = Position
Refresh()
End Sub
If there is an image you don't want on the animation you can press "Delete Frame", this will delete the name of the image shown from the arraylist and adjust the amount of frames. If instead you want a subset of images, you can press "Start Here", move few frames forward and press "Finish Here". This will create a shorter animation starting with the image selected first and finishing with the one showing when pressed the other button. The final frame must be higher than the initial one. The name of the frames is loaded on the work array(WorkAry).
Private Sub btnDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDelete.Click
ImageArray.RemoveAt(N)
LoadImages()
End Sub
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
Start = N
End Sub
Private Sub btnEnd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEnd.Click
Finish = N
WorkAry.Clear()
For i As Integer = Start To Finish
WorkAry.Add(ImageArray(i))
Next
ImageArray.Clear()
For i As Integer = 0 To WorkAry.Count - 1
ImageArray.Add(WorkAry(i))
Next
N = ImageArray.Count - 1
End Sub
Now you have set the amount of frames, you could reassemble the animation by pressing "Animate".
This will call the assemble Subroutine withe the option "1"
Public Sub Assemble(ByVal But As Integer)
Me.Cursor = Cursors.WaitCursor
'Variable declaration
Dim memoryStream As MemoryStream
Dim binaryWriter As BinaryWriter
Dim image As Image
Dim buf1 As [Byte]()
Dim buf2 As [Byte]()
Dim buf3 As [Byte]()
memoryStream = New MemoryStream()
buf2 = New [Byte](18) {}
buf3 = New [Byte](7) {}
buf2(0) = 33
'extension introducer
buf2(1) = 255
'application extension
buf2(2) = 11
'size of block
buf2(3) = 78
'N
buf2(4) = 69
'E
buf2(5) = 84
'T
buf2(6) = 83
'S
buf2(7) = 67
'C
buf2(8) = 65
'A
buf2(9) = 80
'P
buf2(10) = 69
'E
buf2(11) = 50
'2
buf2(12) = 46
'.
buf2(13) = 48
'0
buf2(14) = 3
'Size of block
buf2(15) = 1
'
buf2(16) = 0
'
buf2(17) = 0
'
buf2(18) = 0
'Block terminator
buf3(0) = 33
'Extension introducer
buf3(1) = 249
'Graphic control extension
buf3(2) = 4
'Size of block
buf3(3) = 9
'Flags: reserved, disposal method, user input, transparent color
buf3(4) = 10 ' 88
If ckSlide.Checked = True Then
'Delay time low byte
buf3(5) = 1
'Delay time high byte
buf3(6) = 0
Else
'Delay time low byte
buf3(5) = 0 '1
'Delay time high byte
buf3(6) = 255
End If
'Transparent color index
buf3(7) = 0
'Block terminator
NewName = GetNewName1()
lbOutput.Text = NewName
binaryWriter = New BinaryWriter(File.Open(NewName, FileMode.Create))
For picCount As Integer = 0 To ImageArray.Count - 1 'stringCollection.Count - 1
Select Case But
Case 1
'Animate
image = Bitmap.FromFile(ImageArray(picCount))
If ckDark.Checked = True Then image = Dark(image)
If rbSepiaTone.Checked = True Then image = Sepia(image)
If rbGrayScale.Checked = True Then image = Grayscale(image)
If ckGhost.Checked = True Then Ghost(image)
If ckFlip.Checked = True Then image.RotateFlip(RotateFlipType.RotateNoneFlipX)
Case 2
If MemPic IsNot Nothing Then
image = MemPic(picCount)
If ckDark.Checked = True Then image = Dark(image)
If rbSepiaTone.Checked = True Then image = Sepia(image)
If rbGrayScale.Checked = True Then image = Grayscale(image)
If ckGhost.Checked = True Then Ghost(image)
If ckFlip.Checked = True Then image.RotateFlip(RotateFlipType.RotateNoneFlipX)
Else
MessageBox.Show("Please Select Something")
End If
End Select
image.Save(memoryStream, ImageFormat.Gif)
buf1 = memoryStream.ToArray()
If picCount = 0 Then
'only write these the first time....
binaryWriter.Write(buf1, 0, 781)
'Header & global color table
'Application extension
binaryWriter.Write(buf2, 0, 19)
End If
binaryWriter.Write(buf3, 0, 8)
'Graphic extension
binaryWriter.Write(buf1, 781, buf1.Length - 782)
'Image data
' If picCount = stringCollection.Count - 1 Then
If picCount = ImageArray.Count - 1 Then
'only write this one the last time....
'Image terminator
binaryWriter.Write(";")
End If
memoryStream.SetLength(0)
Progress.Value = 100 * picCount / ImageArray.Count
Next
binaryWriter.Close()
pbSelect.Invalidate()
memoryStream.Close()
Me.Cursor = Cursors.Default
pbSelect.Image = image.FromFile(ImageArray(N))
pbSelect.Refresh()
Progress.Value = 0
End Sub
Here is where the images are converted to gif, and assembled. A new animation will be created with a sequential name:
Public Function GetNewName1() As String
Dim i As Integer
Dim str As String = ""
For i = 1 To 1000
If i < 10 Then str = "Animation_00" & i.ToString & ".gif"
If i > 9 And i < 100 Then str = "Animation_0" & i.ToString & ".gif"
If i > 99 Then str = "Animation_" & i.ToString & ".gif"
If i > 900 Then MsgBox("You Have Over 900 Pictures, Please Check And Delete Unnecesary Ones")
If Not System.IO.File.Exists(str) Then
Exit For
End If
Next
Return str
End Function
and the resulting image displayed on pbResult.
That's it! And it was easy.
If you want other types of manipulation you have checkboxes , radio buttons and other command buttons:
Selecting "SlideShow" will make the animation very slow, frame by frame.
"Flip" will make a mirror animation, "Ghost" will get edges of the images, it works in conjunction with a trackbar to get more or les border. This bar appears when the "Ghost" option is selected. Also I provided a Progress bar to show the activity due to the slow process, even with lockbits, because all the images are processed one by one.
There is also the option of "Dark" that changes the intensity of the image. The ghost option works better with dark images. The trackbar that adjusts it appears when the option is selected. When Scrolling any of the two trackbars labels with values will appear and disappear.
Private Function Ghost(ByVal img) As Image
Dim countx, county As Integer
Dim Tol As Integer = TrackBar1.Value '30
Try
Dim rect As Rectangle = Rectangle.Round(img.GetBounds(GraphicsUnit.Pixel))
Dim wid As Integer = img.Width
Dim hgt As Integer = img.Height
' Dim img As New Bitmap(wid, hgt)
' img = WorkImg.Clone
Dim bmpSr As BitmapData = img.LockBits(New Rectangle(0, 0, img.Width, img.Height),
ImageLockMode.ReadWrite, img.PixelFormat)
Dim ptrSr As IntPtr = bmpSr.Scan0
Dim R, G, B, A, A1, A2, A3, A4 As Integer
R = 2
G = 1
B = 0
A = 3
Dim bytesSr As Integer = bmpSr.Stride * img.Height
Dim rgbvaluesSr(bytesSr) As Byte
System.Runtime.InteropServices.Marshal.Copy(ptrSr, rgbvaluesSr, 0, bytesSr)
'For i As Integer = 0 To rgbvaluesSr.Length - 4 Step 4
For county = 0 To img.Height - 2
If img.PixelFormat = System.Drawing.Imaging.PixelFormat.Format24bppRgb Then
For countx = county * bmpSr.Stride To (county + 1) * bmpSr.Stride - 6 Step 3
A1 = CInt(rgbvaluesSr(countx + R)) + CInt(rgbvaluesSr(countx + G)) + CInt(rgbvaluesSr
(countx + B))
A2 = CInt(rgbvaluesSr(countx + 4 + R)) + CInt(rgbvaluesSr(countx + 4 + G)) + CInt
(rgbvaluesSr(countx + 4 + B))
A3 = CInt(rgbvaluesSr(countx + R + bmpSr.Stride)) + CInt(rgbvaluesSr(countx + G +
bmpSr.Stride)) + CInt(rgbvaluesSr(countx + B + bmpSr.Stride))
A4 = CInt(rgbvaluesSr(countx + 4 + R + bmpSr.Stride)) + CInt(rgbvaluesSr(countx + 4 + G +
bmpSr.Stride)) + CInt(rgbvaluesSr(countx + 4 + B + bmpSr.Stride))
'If (A2 - A1) > Tol Or (A3 - A1) > Tol Or (A4 - A1) > Tol Then
If Math.Abs(A2 - A1) > Tol Or Math.Abs(A3 - A1) > Tol Or Math.Abs(A4 - A1) > Tol Then
' Comment Next Lines To Get Color Edges
rgbvaluesSr(countx + R) = 0
rgbvaluesSr(countx + G) = 0
rgbvaluesSr(countx + B) = 0
Else
rgbvaluesSr(countx + R) = 255
rgbvaluesSr(countx + G) = 255
rgbvaluesSr(countx + B) = 255
End If
If countx = (county + 1) * bmpSr.Stride - 6 Then
'Dark Line To the Right
rgbvaluesSr(countx + R + 4) = 255
rgbvaluesSr(countx + G + 4) = 255
rgbvaluesSr(countx + B + 4) = 255
rgbvaluesSr(countx + R + 8) = 255
rgbvaluesSr(countx + G + 8) = 255
rgbvaluesSr(countx + B + 8) = 255
rgbvaluesSr(countx + R + 12) = 255
rgbvaluesSr(countx + G + 12) = 255
rgbvaluesSr(countx + B + 12) = 255
End If
Next countx
ElseIf img.PixelFormat = System.Drawing.Imaging.PixelFormat.Format32bppArgb Then
For countx = county * bmpSr.Stride To (county + 1) * bmpSr.Stride - 8 Step 4
A1 = CInt(rgbvaluesSr(countx + R)) + CInt(rgbvaluesSr(countx + G)) + CInt(rgbvaluesSr
(countx + B))
A2 = CInt(rgbvaluesSr(countx + 4 + R)) + CInt(rgbvaluesSr(countx + 4 + G)) + CInt
(rgbvaluesSr(countx + 4 + B))
A3 = CInt(rgbvaluesSr(countx + R + bmpSr.Stride)) + CInt(rgbvaluesSr(countx + G +
bmpSr.Stride)) + CInt(rgbvaluesSr(countx + B + bmpSr.Stride))
A4 = CInt(rgbvaluesSr(countx + 4 + R + bmpSr.Stride)) + CInt(rgbvaluesSr(countx + 4 + G +
bmpSr.Stride)) + CInt(rgbvaluesSr(countx + 4 + B + bmpSr.Stride))
'If (A2 - A1) > Tol Or (A3 - A1) > Tol Or (A4 - A1) > Tol Then
If Math.Abs(A2 - A1) > Tol Or Math.Abs(A3 - A1) > Tol Or Math.Abs(A4 - A1) > Tol Then
rgbvaluesSr(countx + A) = 255
rgbvaluesSr(countx + R) = 0
rgbvaluesSr(countx + G) = 0
rgbvaluesSr(countx + B) = 0
Else
rgbvaluesSr(countx + A) = 255
rgbvaluesSr(countx + R) = 255
rgbvaluesSr(countx + G) = 255
rgbvaluesSr(countx + B) = 255
End If
If countx = (county + 1) * bmpSr.Stride - 8 Then
'Dark Line To the Right
rgbvaluesSr(countx + A + 4) = 255
rgbvaluesSr(countx + R + 4) = 255
rgbvaluesSr(countx + G + 4) = 255
rgbvaluesSr(countx + B + 4) = 255
rgbvaluesSr(countx + A + 8) = 255
rgbvaluesSr(countx + R + 8) = 255
rgbvaluesSr(countx + G + 8) = 255
rgbvaluesSr(countx + B + 8) = 255
rgbvaluesSr(countx + A + 12) = 255
rgbvaluesSr(countx + R + 12) = 255
rgbvaluesSr(countx + G + 12) = 255
rgbvaluesSr(countx + B + 12) = 255
End If
Next countx
Else
MessageBox.Show("No Provisions Fot This Format")
End If
Next county
System.Runtime.InteropServices.Marshal.Copy(rgbvaluesSr, 0, ptrSr, bytesSr)
img.UnlockBits(bmpSr)
Catch
MessageBox.Show("Error")
End Try
Return img
End Function
If you select "Gray" or "Sepia" you transform the colors of the images. "Normal" will cancel them.
Private Function Sepia(ByVal img) As Image
Dim image_attr As New ImageAttributes
' Dim img As Image
'~29%,57%,14%
Dim cmy As ColorMatrix = New ColorMatrix(New Single()() _
{ _
New Single() {0.32645, 0.29305, 0.22633, 0.0, 0.0}, _
New Single() {0.64149, 0.57594, 0.44491, 0.0, 0.0}, _
New Single() {0.15752, 0.14144, 0.10929, 0.0, 0.0}, _
New Single() {0.0, 0.0, 0.0, 1.0, 0.0}, _
New Single() {0.001, 0.001, 0.001, 0.0, 1.0}})
Try
Dim rect As Rectangle = Rectangle.Round(img.GetBounds(GraphicsUnit.Pixel))
Dim wid As Integer = img.Width
Dim hgt As Integer = img.Height
img = ConvertToRGB(img)
Dim gr As Graphics = Graphics.FromImage(img)
gr.SmoothingMode = SmoothingMode.HighQuality
gr.CompositingQuality = CompositingQuality.HighQuality
gr.InterpolationMode = InterpolationMode.High
image_attr.SetColorMatrix(cmy)
gr.DrawImage(img, rect, 0, 0, wid, hgt, GraphicsUnit.Pixel, image_attr)
Return img
Catch
MessageBox.Show("Error")
End Try
Return img
End Function
Private Function Grayscale(ByVal img As Image) As Image
Dim image_Attr As New ImageAttributes
Dim rLum As Single = 0.2225 '0.3086
Dim gLum As Single = 0.7169 '0.0694
Dim bLum As Single = 0.0606 '0.0820
Dim cmy As ColorMatrix = New ColorMatrix(New Single()() _
{ _
New Single() {rLum, rLum, rLum, 0, 0}, _
New Single() {gLum, gLum, gLum, 0, 0}, _
New Single() {bLum, bLum, bLum, 0, 0}, _
New Single() {0, 0, 0, 1, 0}, _
New Single() {0, 0, 0, 0, 0}})
Try
Dim rect As Rectangle = Rectangle.Round(img.GetBounds(GraphicsUnit.Pixel))
Dim wid As Integer = img.Width
Dim hgt As Integer = img.Height
img = ConvertToRGB(img)
Dim gr As Graphics = Graphics.FromImage(img)
gr.SmoothingMode = SmoothingMode.HighQuality
gr.CompositingQuality = CompositingQuality.HighQuality
gr.InterpolationMode = InterpolationMode.High
image_Attr.SetColorMatrix(cmy)
gr.DrawImage(img, rect, 0, 0, wid, hgt, GraphicsUnit.Pixel, image_Attr)
Return img
Catch
MessageBox.Show("Error")
End Try
Return img
End Function
The button "Reverse" Changes the order of the names in the arraylist, so when assembled they go backwards. This is the same routine "Assemble".
Private Sub btnReverse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles
btnReverse.Click
ImageArray.Reverse()
Assemble(1)
pbResult.Image = Image.FromFile(NewName)
End Sub
I found wastefull to save all the animations to disk and then select the ones worth to keep, so I supplied a "Preview" routine that will show one frame roughly the way the animation will be produced:
Private Sub btnFramePView_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles
btnFramePView.Click
preview()
End Sub
Private Sub Preview()
Dim Im As Bitmap
Im = pbSelect.Image.Clone
If ckDark.Checked = True Then Im = Dark(Im)
If rbSepiaTone.Checked = True Then Im = Sepia(Im)
If rbGrayScale.Checked = True Then Im = Grayscale(Im)
If ckGhost.Checked = True Then Ghost(Im)
If ckFlip.Checked = True Then Im.RotateFlip(RotateFlipType.RotateNoneFlipX)
pbResult.Image = Im
End Sub
This is the same procedure on the assemble routine, but with only one frame, the one in the picturebox.
Now. When you left-click and drag the mouse on pbSelect, you will have a rectangle drawn there. At mouseup this rectangle is selected and the areas in that position in all the images is selected. You can select on another frame if the first one is not suitable because has a title or is blank, and the effect will be the same. Now you could press "Crop" and a smaller size image will appear with a section of the original.
Private Sub btnCrop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCrop.Click
MemPic.Clear()
If pbResult.Image IsNot Nothing Then
Dim TempImage As Image
For Each N As Object In ImageArray
W = GetImageWidth(N)
H = GetImageHeight(N)
TempImage = CropImage(Image.FromFile(N))
If WasAnError = True Then
MemPic.Clear()
WasAnError = False
Exit Sub
Else
MemPic.Add(TempImage)
End If
Next
Assemble(2)
Else
MessageBox.Show("Select Something, Please")
Exit Sub
End If
pbResult.Image = Image.FromFile(NewName)
End Sub
Assemble is called with option "2". The information appears on the label above the button.
Note that these animations are also saved to disk.
Most of these options are cummulative, what means that an image can be cropped and sepia, or reverted and double the size:
Select Case But
Case 1
'Animate
image = Bitmap.FromFile(ImageArray(picCount))
If ckDark.Checked = True Then image = Dark(image)
If rbSepiaTone.Checked = True Then image = Sepia(image)
If rbGrayScale.Checked = True Then image = Grayscale(image)
If ckGhost.Checked = True Then Ghost(image)
If ckFlip.Checked = True Then image.RotateFlip(RotateFlipType.RotateNoneFlipX)
Case 2
If MemPic IsNot Nothing Then
image = MemPic(picCount)
If ckDark.Checked = True Then image = Dark(image)
If rbSepiaTone.Checked = True Then image = Sepia(image)
If rbGrayScale.Checked = True Then image = Grayscale(image)
If ckGhost.Checked = True Then Ghost(image)
If ckFlip.Checked = True Then image.RotateFlip(RotateFlipType.RotateNoneFlipX)
Else
MessageBox.Show("Please Select Something")
End If
End Select
The "Normal, "Sepia" and "Gray" will exclude each other.
Now the resizing:
All is accomplished with a subroutine where a mathematical operation sets the size of the bitmap:
Private Sub btnResize_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btn50.Click,
btn33.Click, btn25.Click, btn150.Click, btn75.Click, btn200.Click
Dim Orig_bmp As Bitmap
'following code resizes pictures
MemPic.Clear()
For NX As Integer = 0 To ImageArray.Count - 1
W = GetImageWidth(ImageArray(0))
H = GetImageHeight(ImageArray(0))
If rbNormal.Checked = True Then
Orig_bmp = New Bitmap(Image.FromFile(ImageArray(NX)))
ElseIf rbGrayScale.Checked = True Then
Orig_bmp = New Bitmap(Grayscale((Image.FromFile(ImageArray(NX)))))
ElseIf rbSepiaTone.Checked = True Then
Orig_bmp = New Bitmap(Sepia(Image.FromFile(ImageArray(NX))))
Else
' Orig_bmp = New Bitmap(Dark(Image.FromFile(ImageArray(NX))))
End If
Dim x, y As Integer
If sender Is btn50 Then
x = W / 2
y = H / 2
End If
If sender Is btn33 Then
x = W / 3
y = H / 3
End If
If sender Is btn25 Then
x = W / 4
y = H / 4
End If
If sender Is btn150 Then
x = W * 3 / 2
y = H * 3 / 2
End If
If sender Is btn75 Then
x = W * 3 / 4
y = H * 3 / 4
End If
If sender Is btn200 Then
x = W * 2
y = H * 2
End If
' Dim Small As New Bitmap(Width, Height)
Dim Small As New Bitmap(x, y)
Dim G As Graphics = Graphics.FromImage(Small)
G.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
G.DrawImage(Orig_bmp, New Rectangle(0, 0, x, y), New Rectangle(0, 0, Orig_bmp.Width, Orig_bmp.Height),
GraphicsUnit.Pixel)
G.Dispose()
MemPic.Add(Small)
Next
Assemble(2)
pbResult.Image = Image.FromFile(NewName)
Refresh()
End Sub
The assemble operation is called with paremeter "2".
It is worth to mention that the numbers on filenames are treated like characters, so to keep the order of the frames you need to take provisions.
The numbers as characters will give this problem: 198,199,2,20,21,22... 29,200,201... For this I use:
Private Sub Save(ByVal Pic As Image)
Dim i As Integer
Dim str As String = ""
For i = 1 To 1000
If i < 10 Then str = "Pic_00" & i.ToString & ".gif"
If i > 9 And i < 100 Then str = "Pic_0" & i.ToString & ".gif"
If i > 99 Then str = "Pic_" & i.ToString & ".gif"
If i > 900 Then MsgBox("You Have Over 900 Pictures, Please Check And Delete Unnecesary Ones")
If Not System.IO.File.Exists(str) Then
Try
Pic.Save(str, System.Drawing.Imaging.ImageFormat.Gif)
Catch Ex As Exception
MsgBox("Could Not Write To Location")
End Try
Exit For
End If
Next
End Sub
And other similar subroutines.
If you select "Scan Folder" from the menu, the program will read the jpg files from the folder and put them in the arraylist. If you press animate, you will have a greek salad of images assembled. The result will have the dimension of the first image. The large ones will be truncated and the smaller ones padded with black pixels. You need to select frames if you want to get something usefull from it. You could assemble images obtained somewhere else, or created by you on a paint program. But be careful on the names. I use a renaming rousine to process them.
Private Sub scan()
ImageArray.Clear()
Try
Dim di As New IO.DirectoryInfo(Environment.CurrentDirectory)
Dim aryFi As IO.FileInfo() = di.GetFiles("*.jpg")
Pictures = aryFi.Count
Dim fi As IO.FileInfo
For Each fi In aryFi
File_Rename(fi.Name)
Next
Dim aryFi2 As IO.FileInfo() = di.GetFiles("*.jpg")
For Each fi In aryFi2
ImageArray.Add(fi.Name) 'Original jpg Files
Next
If ImageArray IsNot Nothing Then
ImageArray.Sort()
If ImageArray(0) IsNot Nothing Then
pbSelect.Image = Image.FromFile(ImageArray(0))
Im = pbSelect.Image.Clone
Label2.Text = ImageArray(0)
End If
End If
Catch
MessageBox.Show("Didn't Find Any Jpg Fles In Directory, Sorry")
End Try
End Sub
Private Sub File_Rename(ByVal OldName As String)
'Frame3.jpg
If OldName.Length > 12 Then Exit Sub 'Already processed
Dim NewFname As String = ""
Dim Len As Integer
Dim Ending = OldName.Substring(5)
Len = Ending.Length
Try
Select Case Len
Case 5
NewFname = "Frame000" & Ending
Case 6
NewFname = "Frame00" & Ending
Case 7
NewFname = "Frame0" & Ending
Case 8
NewFname = "Frame" & Ending
End Select
My.Computer.FileSystem.RenameFile(OldName, NewFname)
Catch
MessageBox.Show("We Got An Error")
End Try
End Sub
If you check the option "Join" the arraylist is not cleared, so you will load another animation and the frames will be added. The dimensions of the first ones will determine the size of the frames. If the animations are of different sizes the smaller ones will be padded with black pixels, and the larger ones will be truncated.
One last note: The ConvertTORGB will convert the images to be able to manipulate them as I said before, due to the old history:
"Graphics Objects Can Not Be Created From Indexed..."
Public Shared Function ConvertToRGB(ByVal original As Bitmap) As Bitmap
Dim newImage As New Bitmap(original.Width, original.Height,
System.Drawing.Imaging.PixelFormat.Format32bppArgb)
newImage.SetResolution(original.HorizontalResolution, original.VerticalResolution)
Dim g As Graphics = Graphics.FromImage(newImage)
g.DrawImageUnscaled(original, 0, 0)
g.Dispose()
Return newImage
End Function
I think these cover almost everything.
This is the program. Check it and please, and if you can, report bugs.
See the zip included.
Thank you.
Attached File(s)
-
GifProcessor.zip (61.31K)
Number of downloads: 192
MultiQuote
| 