View Single Post
Old 5th February 2011, 06:34   #12  |  Link
OvejaNegra
ekTOMBE STUDIOS
 
OvejaNegra's Avatar
 
Join Date: Dec 2005
Location: Cuba
Posts: 254
with VB.net IS POSSSIBLE to process a DIB.
with VB6 IS POSSIBLE to process a DIB.
Take a look at the sources of staxrip and,well, ill find my old VB6 samples.
IS posible.
Calling to the api for things like this is very painfull with VB.net. Thats why i want write a wrapper using c++cli but i need some help with the AVS api.

this is from staxrip: it works

Quote:
Imports Microsoft.VisualBasic
Imports System
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Imports System.Windows.Forms
Imports System.Reflection
Imports System.Diagnostics
Imports System.Text
Imports Microsoft.Win32



Public Class RegistryHelp
Public Shared CurrentUser As New RootKey(Registry.CurrentUser)
Public Shared LocalMachine As New RootKey(Registry.LocalMachine)
Public Shared ClassesRoot As New RootKey(Registry.ClassesRoot)

Private Shared ApplicationKey As String = "Software\" + Application.ProductName

Public Class RootKey
Private RootRegistryKey As RegistryKey

Public Sub New(ByVal rootKey As RegistryKey)
RootRegistryKey = rootKey
End Sub

Public Function GetValue(ByVal key As String, ByVal name As String) As Object
Dim ret As Object = Nothing
Dim subKey As RegistryKey = RootRegistryKey.OpenSubKey(key)

If Not subKey Is Nothing Then
ret = subKey.GetValue(name)
subKey.Close()
End If

Return ret
End Function

Public Function GetString(ByVal key As String, ByVal name As String) As String
Return DirectCast(GetValue(key, name), String)
End Function

Public Sub SetValue(ByVal key As String, ByVal name As String, ByVal value As Object)
Dim subKey As RegistryKey = RootRegistryKey.OpenSubKey(key, True)

If subKey Is Nothing Then
subKey = RootRegistryKey.CreateSubKey(key)
End If

subKey.SetValue(name, value)
subKey.Close()
End Sub

Public Sub DeleteKey(ByVal key As String)
Dim rk As RegistryKey = RootRegistryKey.OpenSubKey(key)

If Not rk Is Nothing Then
If rk.SubKeyCount = 0 Then
RootRegistryKey.DeleteSubKey(key)
Else
RootRegistryKey.DeleteSubKeyTree(key)
End If
End If
End Sub

Public Sub DeleteValue(ByVal key As String, ByVal name As String)
Dim rk As RegistryKey = RootRegistryKey.OpenSubKey(key, True)

If Not rk Is Nothing Then
rk.DeleteValue(name, False)
rk.Close()
End If
End Sub

Public Sub SetApplicationValue(ByVal name As String, ByVal value As Object)
SetValue(ApplicationKey, name, value)
End Sub

Public Function GetApplicationValue(ByVal name As String) As Object
Return GetValue(ApplicationKey, name)
End Function

Public Function GetApplicationString(ByVal name As String) As String
Return GetString(ApplicationKey, name)
End Function
End Class

Public Shared Sub SetAssociation(ByVal extNoDot As String)
Dim value As String = RegistryHelp.ClassesRoot.GetString("." + extNoDot, "")

If value Is Nothing OrElse value = "" Then
Dim rk As RegistryKey = Registry.ClassesRoot.CreateSubKey("." + extNoDot)
rk.SetValue("", extNoDot + "file")
rk.Close()
value = extNoDot + "file"
End If

Dim rk2 As RegistryKey = Registry.ClassesRoot.CreateSubKey( _
value + "\shell\" + Application.ProductName + "\command")

rk2.SetValue("", """" + Application.ExecutablePath + """ ""%1"" ""%n""")
rk2.Close()

Dim rk3 As RegistryKey = Registry.ClassesRoot.CreateSubKey(value + "\shell")
rk3.SetValue("", Application.ProductName)
rk3.Close()

RegistryHelp.ClassesRoot.DeleteKey(value + "\DefaultIcon")
RegistryHelp.CurrentUser.DeleteValue("Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\." + extNoDot, "Application")
End Sub

Public Shared Sub SetContextMenu(ByVal extNoDot As String)
Dim value As String = RegistryHelp.ClassesRoot.GetString("." + extNoDot, "")

If value Is Nothing OrElse value = "" Then
Dim rk As RegistryKey = Registry.ClassesRoot.CreateSubKey("." + extNoDot)
rk.SetValue("", extNoDot + "file")
rk.Close()
value = extNoDot + "file"
End If

Dim rk2 As RegistryKey = Registry.ClassesRoot.CreateSubKey( _
value + "\shell\" + Application.ProductName + "\command")

rk2.SetValue("", """" + Application.ExecutablePath + """ ""%1"" ""%n""")
rk2.Close()
End Sub

Public Shared Sub DeleteAssociation(ByVal extension As String)
Dim value As String = RegistryHelp.ClassesRoot.GetString("." + extension, "")
RegistryHelp.ClassesRoot.DeleteKey(value + "\shell\" + Application.ProductName)
End Sub
End Class

Public Class AVIFile
Public CropLeft, CropTop, CropRight, CropBottom As Integer

Private AviFile As IntPtr
Private FrameObject As IntPtr
Private AviStream As IntPtr
Private StreamInfo As AVISTREAMINFO
Private Control As Control
Private Sourcefile As String

Private FrameCountValue As Integer

Public ReadOnly Property FrameCount() As Integer
Get
Return FrameCountValue
End Get
End Property

Public ReadOnly Property FrameRate() As Single
Get
Return StreamInfo.dwRate / CSng(StreamInfo.dwScale)
End Get
End Property

Private FourCCValue As String

Public ReadOnly Property FourCC() As String
Get
Return FourCCValue
End Get
End Property

Public ReadOnly Property FrameSize() As Size
Get
Return New Size(CInt(StreamInfo.rcFrame.right), CInt(StreamInfo.rcFrame.bottom))
End Get
End Property

Private PositionValue As Integer

Public Property Position() As Integer
Get
Return PositionValue
End Get
Set(ByVal value As Integer)
If value < 0 Then
PositionValue = 0
ElseIf value > FrameCount - 1 Then
PositionValue = FrameCount - 1
Else
PositionValue = value
End If
End Set
End Property

Public Sub Open(ByVal fileName As String, ByVal c As Control)
Open(fileName)
Control = c
End Sub

Private Function GetFourCC(ByVal value As Integer) As String
Return Encoding.ASCII.GetString(BitConverter.GetBytes(value))
End Function

Public Sub Open(ByVal path As String)
Try
Sourcefile = path

AVIFileInit()

Dim OF_SHARE_DENY_WRITE As Integer = 32

If AVIFileOpen(AviFile, path, OF_SHARE_DENY_WRITE, IntPtr.Zero) <> 0 Then
Throw New Exception("AVIFileOpen failed")
End If

If AVIFileGetStream(AviFile, AviStream, 1935960438, 0) <> 0 Then 'FourCC for vids
Throw New Exception("AVIFileGetStream failed")
End If

FrameCountValue = AVIStreamLength(AviStream.ToInt32())

StreamInfo = New AVISTREAMINFO()

If AVIStreamInfo_(AviStream.ToInt32(), StreamInfo, Marshal.SizeOf(StreamInfo)) <> 0 Then
Throw New Exception("AVIStreamInfo failed")
End If

FourCCValue = GetFourCC(Convert.ToInt32(StreamInfo.fccHandler))

If FourCC = "YV12" Then
FrameObject = AVIStreamGetFrameOpen(AviStream, 1)

If FrameObject = IntPtr.Zero Then
Throw New Exception("Failed to decode YV12.")
End If
Else
FrameObject = AVIStreamGetFrameOpen(AviStream, 0)

If FrameObject = IntPtr.Zero Then
Throw New Exception("AVIStreamGetFrameOpen failed")
End If
End If
Catch ex As Exception
HandleException(ex)
End Try
End Sub

Public Sub HandleException(ByVal ex As Exception)
Dim sb As New StringBuilder
Dim yv12 As String = RegistryHelp.LocalMachine.GetString("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Drivers32", "VIDC.YV12")

sb.AppendLine("message: " + ex.Message)
sb.AppendLine("yv12 decoder: " + yv12)
sb.AppendLine("FourCC: " + FourCCValue)
sb.AppendLine("yv12 decoder exists: ") '+ File.Exists(CommonDirs.System + yv12).ToString)
sb.AppendLine("colordepth: " + Screen.PrimaryScreen.BitsPerPixel.ToString)
sb.AppendLine("path: " + Sourcefile)

'If Filepath.GetExt(Sourcefile) = ".avs" Then
' If File.Exists(Sourcefile) Then
' sb.AppendLine("script: " + vbCrLf + vbCrLf + StringHelp.ReadFile(Sourcefile))
' Else
' sb.AppendLine("file does not exist!")
' End If
'End If

Throw New Exception(sb.ToString)
End Sub

Public Sub Close()
If Not FrameObject = IntPtr.Zero Then
AVIStreamGetFrameClose(FrameObject)
FrameObject = IntPtr.Zero
End If

If Not AviStream = IntPtr.Zero Then
AVIStreamRelease(AviStream)
AviStream = IntPtr.Zero
End If

If Not AviFile = IntPtr.Zero Then
AVIFileRelease(AviFile)
AviFile = IntPtr.Zero
End If

AVIFileExit()
End Sub

Public Sub Draw()
If Not Control Is Nothing AndAlso Control.Visible Then
Dim g As Graphics = Control.CreateGraphics()
Draw(g)
g.Dispose()
End If
End Sub

Public Sub Draw(ByVal g As Graphics)
Try
If Not Control Is Nothing AndAlso Control.Visible AndAlso Not FrameObject = IntPtr.Zero Then
Dim img As Image = GetBMPFromDib(New IntPtr(AVIStreamGetFrame(FrameObject, Position)))

If CropLeft = 0 AndAlso CropTop = 0 AndAlso CropRight = 0 AndAlso CropBottom = 0 Then
g.DrawImage(img, Control.ClientRectangle)
Else
Dim factorX As Single = CSng(Control.Width) / img.Width
Dim factorY As Single = CSng(Control.Height) / img.Height

Dim left As Single = CropLeft * factorX
Dim right As Single = CropRight * factorX
Dim top As Single = CropTop * factorY
Dim bottom As Single = CropBottom * factorY

Dim rectDest As RectangleF = New RectangleF()

rectDest.X = left
rectDest.Y = top
rectDest.Width = Control.Width - left - right
rectDest.Height = Control.Height - top - bottom

Dim rectSrc As Rectangle = New Rectangle()

rectSrc.X = CropLeft
rectSrc.Y = CropTop
rectSrc.Width = img.Width - CropLeft - CropRight
rectSrc.Height = img.Height - CropTop - CropBottom

g.DrawImage(img, rectDest, rectSrc, GraphicsUnit.Pixel)

Dim sb As SolidBrush = New SolidBrush(Color.White)

g.FillRectangle(sb, 0, 0, left, Control.Height)
g.FillRectangle(sb, 0, 0, Control.Width, top)
g.FillRectangle(sb, Control.Width - right, 0, right, Control.Height)
g.FillRectangle(sb, 0, Control.Height - bottom, Control.Width, bottom)

sb.Dispose()
End If
End If
Catch ex As Exception
HandleException(ex)
End Try
End Sub

Public Function GetBitmap() As Bitmap
Return GetBMPFromDib(New IntPtr(AVIStreamGetFrame(FrameObject, Position)))
End Function

Public Function GetBMPFromDib(ByVal pDIB As IntPtr) As Bitmap
Dim pPix As IntPtr = New IntPtr(pDIB.ToInt32() + Marshal.SizeOf(GetType(BITMAPINFOHEADER)))

Dim mi As MethodInfo = GetType(Bitmap).GetMethod("FromGDIplus", BindingFlags.Static Or BindingFlags.NonPublic)

Dim pBmp As IntPtr = IntPtr.Zero
Dim status As Integer = GdipCreateBitmapFromGdiDib(pDIB, pPix, pBmp)

Return CType(mi.Invoke(Nothing, New Object() {pBmp}), Bitmap)
End Function

__________________
So, it works or not???
OvejaNegra is offline   Reply With Quote