ekTOMBE STUDIOS
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???
|