[ممدوح]

هذا الكود مع الشرح

كود :

Public Class Form1

    Dim mThread As Threading.Thread

    ' اسم ملف الفيديو
    Dim filename As String = "filename.mp4"

    ' النص المراد طباعته
    Dim mText As String = "النص المراد طباعته"

    ' حجم ونوع الخط
    Dim mFont As Font = New Font("Arial", 20, FontStyle.Bold)

    ' لو الخط
    Dim mColor As Color = Color.White

    ' خصائص رسم النص
    Dim mStringFormat As New StringFormat(StringFormatFlags.DirectionRightToLeft) With {.Alignment = StringAlignment.Center}

    ' حجم أو مساحة النص
    Dim mTextSize As SizeF

    ' مؤشر مكان النص في الإطار
    Dim positionY As Single

    ' إنشاء كائن كتابة ملف الفيديو
    Dim writer As New AForge.Video.FFMPEG.VideoFileWriter()

    ' صورة الخلفية
    Dim mImage As Image

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        ' الاحتفاظ بصورة الخلفية الموجود في مربع الصورة
        mImage = PictureBox1.Image
    End Sub


    ' حجم مقاس الفيديو
    Dim videoFrameSize As New Size(640, 480)

    ' تعرفات خلصة بالرسم
    Dim videoBitmap As New Bitmap(videoFrameSize.Width, videoFrameSize.Height)
    Dim videoGraphics As Graphics = Graphics.FromImage(videoBitmap)

    ' زر بدء عمل الفيديو
    Private Sub btnStart_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        ' معدل الإطارات في الثانية
        Dim videoFrameRate As Integer = 25

        ' نوع ترميز الفيديو
        Dim videoCodec As AForge.Video.FFMPEG.VideoCodec = AForge.Video.FFMPEG.VideoCodec.MPEG4

        ' معدل دقة الفيديو بالبت
        Dim videoBitRate As Integer = 1000000

        ' إنشاء ملف الفيديو
        writer.Open(filename, videoFrameSize.Width, videoFrameSize.Height, videoFrameRate, videoCodec, videoBitRate)


        ' معرفة حجم أو مساحة النص
        mTextSize = TextRenderer.MeasureText(mText, mFont)

        ' تعديل بداية مكان النص
        positionY = videoFrameSize.Height

        ' تفعيل وتعطيل الأزارير
        Button1.Enabled = False
        Button2.Enabled = True

        ' إنشاء عملية معالجة خلفية
        mThread = New Threading.Thread(AddressOf task)
        Control.CheckForIllegalCrossThreadCalls = False
        mThread.IsBackground = True
        mThread.Start()

    End Sub

    ' زر إيقاف إتمام العملية
    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click

        ' ألغ عملية المعالجة إن كانت قيد العمل
        If mThread.IsAlive Then mThread.Abort()

        ' إغلاق ملف الفيديو
        writer.Close()

        ' تفعيل وتعطيل الأزارير
        Button1.Enabled = True
        Button2.Enabled = False

    End Sub

    ' روتين عملية المعالجة الخلفية
    Sub task()

        ' حلقة تكرار
        Do
            PictureBox1.Invoke(Sub()

                                   ' تلوين الخلفية
                                   videoGraphics.Clear(Color.Black)

                                   ' التأكد من وجود صورة للخلية
                                   If Not IsNothing(mImage) Then
                                       ' رسم صورة الخلفية
                                       videoGraphics.DrawImage(mImage, New Rectangle(0, 0, videoFrameSize.Width, videoFrameSize.Height))
                                   End If

                                   ' رسم النص
                                   videoGraphics.DrawString(mText, mFont, New SolidBrush(mColor), New Rectangle(New Point(0, positionY), videoFrameSize), mStringFormat)

                                   ' إظهار الإطار في مربع الصورة
                                   PictureBox1.Image = videoBitmap

                                   ' اضافة الإطار الى ملف الفيديو
                                   If writer.IsOpen Then
                                       writer.WriteVideoFrame(videoBitmap)
                                   Else
                                       Exit Sub
                                   End If

                                   ' تعديل مكان النص
                                   positionY -= 1 ' سمكن زيادة هذا الرقم لزيادة حركة النص

                               End Sub)

            ' الخروج من حلقة التكرار عند التحقق من اختفاء النص في الأعلى
            If positionY < (-(mTextSize.Height)) Then Exit Do

        Loop

        ' إغلاق ملف الفيديو
        writer.Close()

        ' تفعيل وتعطيل الأزارير
        Button1.Enabled = True
        Button2.Enabled = False

    End Sub

End Class

وهذه صورة للنتيجة