Don't like ads? PRO users don't see any ads ;-)
Public Pastes
Guest

Untitled

By: a guest on Jun 14th, 2012  |  syntax: None  |  size: 3.90 KB  |  hits: 64  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Create Video from ImageSource
  2. Public Function WpfBitmapSourceToBitmap(ByVal source As BitmapSource) As System.Drawing.Bitmap
  3.                 If source Is Nothing Then Return Nothing
  4.                 Dim bmp As New System.Drawing.Bitmap(source.PixelWidth, source.PixelHeight, System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
  5.                 Dim data As System.Drawing.Imaging.BitmapData = bmp.LockBits(New System.Drawing.Rectangle(System.Drawing.Point.Empty, bmp.Size), System.Drawing.Imaging.ImageLockMode.[WriteOnly], System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
  6.                 source.CopyPixels(Int32Rect.Empty, data.Scan0, data.Height * data.Stride, data.Stride)
  7.                 bmp.UnlockBits(data)
  8.                 Return bmp
  9.             End Function
  10.        
  11. Public Class clsAviWriter
  12.     Inherits MAINInterface.TB.Imaging.Pia7.clsDspTemplate
  13.  
  14.  
  15.     Private cAvi As AviReaderWriter.AviFile.AviManager
  16.     Private AviStream As AviReaderWriter.AviFile.VideoStream
  17.     Private AudioStream As AviReaderWriter.AviFile.AudioStream
  18.  
  19.  
  20.     Private cFps As clsTbQueue
  21.     Private OldFpsDate As Date = Now
  22.  
  23.  
  24.  
  25.  
  26.     ''' <summary>
  27.     ''' The image object to paint graphical objects on it
  28.     ''' </summary>
  29.     ''' <value>descriptor of the image</value>
  30.     Public Overrides Property ImageInfo() As MAINInterface.TB.Imaging.Pia7.clsImageInfo
  31.         Get
  32.             Return Me._ImageInfo
  33.         End Get
  34.         Set(ByVal value As MAINInterface.TB.Imaging.Pia7.clsImageInfo)
  35.             Me._ImageInfo = value
  36.             Call WriteFrame()
  37.             Call Me.OnPropertyChanged(Me.Guid)
  38.         End Set
  39.     End Property
  40.  
  41.     Private Sub WriteFrame()
  42.         Dim D As Date = Now
  43.         Dim Fps As Single
  44.  
  45.  
  46.         Me.cFps.Values.Add(D.Subtract(Me.OldFpsDate).Ticks)
  47.         Me.OldFpsDate = D
  48.  
  49.         Me.cFps.Trim()
  50.  
  51.         Fps = 1000 / New TimeSpan(Me.cFps.Average).TotalMilliseconds
  52.         Me.cFps.BufferSize = TB.Math.myTrim(Fps * 1, 1, 1000)
  53.  
  54.  
  55.         If Me.AviStream IsNot Nothing Then
  56.             Me.AviStream.AddFrame(Me._ImageInfo.Image.Clone)
  57.         End If
  58.     End Sub
  59.  
  60.     Public Sub New()
  61.         Me.ClassDescription = "Write images into an avi file"
  62.         Me.cFps = New clsTbQueue(10)
  63.     End Sub
  64.  
  65.  
  66.  
  67.     Private Sub InitializeAvi()
  68.         Dim W As String
  69.         Dim Fps As Single
  70.         Dim di As New IO.DirectoryInfo(TB.SystemMain.AppPath & "Avi")
  71.         TB.FileSystem.CreateDirectories(di)
  72.  
  73.         W = IO.Path.Combine(di.FullName, "Record_" & Now.Ticks.ToString("0") & ".avi")
  74.  
  75.         Me.cAvi = New AviReaderWriter.AviFile.AviManager(W, False)
  76.  
  77.         Dim Opts As New AviReaderWriter.AviFile.Avi.AVICOMPRESSOPTIONS
  78.         Opts.fccType = 0
  79.         Opts.fccHandler = 1684633208
  80.         Opts.dwKeyFrameEvery = 0
  81.         Opts.dwQuality = 0 '0 ... 10000
  82.         Opts.dwFlags = 8 'AVICOMRPESSF_KEYFRAMES = 4
  83.         Opts.dwBytesPerSecond = 0
  84.         Opts.lpFormat = 0
  85.         Opts.lpParms = New IntPtr(0)
  86.         Opts.cbParms = 3532
  87.         Opts.dwInterleaveEvery = 0
  88.  
  89.  
  90.         Fps = 1000 / New TimeSpan(Me.cFps.Average).TotalMilliseconds
  91.  
  92.         'Dim bm1 As Bitmap
  93.         'bm1 = TB.Imaging.CreateReScaledImage(Me.pic.Image, New Size(Me.pic.Image.Width, Me.pic.Image.Height), False)
  94.         Me.AviStream = cAvi.AddVideoStream(Opts, Math.Floor(TB.Math.myTrim(Fps, 1, 50)), Me._ImageInfo.Image.Clone)
  95.  
  96.     End Sub
  97.  
  98.  
  99.     Public Overrides Property Run() As Boolean
  100.         Get
  101.             Return Me._Run
  102.         End Get
  103.         Set(ByVal value As Boolean)
  104.             If Me._Run <> value Then
  105.                 Me._Run = value
  106.                 If Me._Run = True Then
  107.                     Call InitializeAvi()
  108.                 Else
  109.                     If Me.cAvi IsNot Nothing Then
  110.                         Me.cAvi.Close()
  111.                         Me.cAvi = Nothing
  112.                         Me.AviStream = Nothing
  113.                     End If
  114.                 End If
  115.                 Call Me.OnPropertyChanged(Me.Guid)
  116.             End If
  117.         End Set
  118.     End Property
  119.  
  120.  
  121. End Class
create a new version of this paste RAW Paste Data