How do I superimpose subtitles over a movie?

[tedsmith]

I have often wondered how to superimpose say colored richtext of various sizes over a movie to add subtitles without actually changing the movie file itself. (like in a DVD)
The background of the text would have to be transparent and the text would have to "cut a hole' in the movie so parts of it didn't shown through.
Also if the hole is a little bigger than the text it would show nice black edges around the letters.
The test could be in a database with a field to tell it when to change the text in sync to the movie.

Is this superimposition possible in VB6 and how would you go about it?

 

[strongm]

Superimposing (simple, i.e. not richtext) text with an outline over an image is pretty simple, only requiring a couple of lines of code.

I'll illustrate the quick and easy way of doing the necessary superimposition. I'll leave it to you to write the code to find the the DC of the Window you are playing the and dealing with the fact that it will be repainting itself rather often ...

[blue]Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hdc As Long) As Long

Private Sub Command1_Click()
    Dim strOut As String

    With Picture1
        ' The next 6 lines are all just set up for the example
        .FontName = "Verdana"
        .FontBold = True
        .FontSize = 16
        .FillColor = RGB(192, 240, 240)
        .FillStyle = vbSolid
        .ForeColor = 0
        
        strOut = "Look! A subtitle on a picture!"
        
        ' Here is the core code overlaying outlined text into a DC
        ' And we'll illustrate VB native  and API method
        BeginPath .hdc
            ' First three lines illustrate that we can do this - at least partially - with VB methods
            Picture1.ScaleMode = vbPixels ' API method works natively in pixels, so we don't need to do this for TextOut method to work
            Picture1.CurrentY = 50
            Picture1.Print strOut
            TextOut .hdc, 0, 100, strOut, Len(strOut) ' The API way, required if outputting to a non-VB window (or to a VB window without a Print method)
        EndPath .hdc
        StrokeAndFillPath .hdc
        
    End With
End Sub[/blue]

 

[strongm]

(and note no blitting involved ... )

 

[harebrain]

A recent thread along a similar vein in the Delphi forum:
thread102-1459740

 

[strongm]

I'm not sure it is all that similar really. That thread is primarily to do with timing (and for that we really only need the timeGetTime API) rather than superimposition

 

[tedsmith]

Thanks,
Is the Picture1 in your example a WindowMediaPlayer box?
I didn't realise you could 'print' over one. I get an error when I try.

Alternately how can you show a movie in an image box?

I was thinking more of being able to 'bring to the front' a partially transparent image OVER a windowsmediaplayerbox rather than alter the movie picture.

 

[strongm]

>Is the Picture1 in your example a WindowMediaPlayer box?
Nope. As I said "I'll leave it to you to write the code to find the the DC of the Window you are playing the [movie in] and dealing with the fact that it will be repainting itself rather often ..."


>I get an error when I try

??? Can you clarify?

 

[tedsmith]

WindowsMediaPlayer1.print strOut gives an error

 

[strongm]

Ah, right. No, not all controls have a Print method, and the WindowsMediaPlayer control is one of those that do not. You'd have to go with the API solution (and that includes getting the appropriate Font, Pens and Brushes set up in the target Device Context

 

[strongm]

Having said that, I may just have a cunning idea how to achieve this without actually having to worry too much about the media player window (apart from it's position) ... I need to think it through though.

 

[strongm]

OK, this is an proof of concept of the idea (which is close to your thought). You'll need two forms. The first needs a WindowMediaPlayer control (load a movie that plays at least 25 seconds or so) dropped on it and the following code pasted in:

[blue]Option Explicit

Private Sub Form_Load()
    Form1.Show
    WindowsMediaPlayer1.uiMode = "none"
    WindowsMediaPlayer1.Move 0, 0, ScaleWidth, ScaleHeight
    WindowsMediaPlayer1.enableContextMenu = False
    Form2.Width = Width
    Form2.Height = Height
    Form2.Top = Top
    Form2.Left = Left
    Form2.Show vbModal, Me
    Unload Me
End Sub

Private Sub WindowsMediaPlayer1_StatusChange()
    Form2.Timer1.Enabled = True
End Sub
[/blue]

Not too complex so far

The second form needs a timer on it, and then paste in the following code:

[blue]Option Explicit

Private Declare Function SetWindowPos Lib "user32" (ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOSIZE = &H1
Private Const SWP_HIDEWINDOW = &H80
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal Hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Const LWA_COLORKEY = &H1&

'Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hdc As Long) As Long

Private subtitles(0 To 5) As String

Private Sub Form_Load()
    Dim StyleEx As Long
    
    ' Various setup stuff
    With Form2
        .ScaleMode = vbPixels
        .AutoRedraw = True
        .BackColor = RGB(10, 20, 30)
        .FontName = "Verdana"
        .FontBold = True
        .FontSize = 16
        .FillStyle = vbSolid
        .ForeColor = vbBlack
    End With

    ' Ok, play the transparent trick
    StyleEx = GetWindowLong(Hwnd, GWL_EXSTYLE)
    StyleEx = StyleEx Or WS_EX_LAYERED
    SetWindowLong Hwnd, GWL_EXSTYLE, StyleEx
    SetLayeredWindowAttributes Hwnd, RGB(10, 20, 30), 0, LWA_COLORKEY
    
    ' SOme example subtitles
    subtitles(0) = "First subtitle"
    subtitles(1) = "Second subtitle"
    subtitles(2) = "Third subtitle"
    subtitles(3) = "Fourth subtitle"
    subtitles(4) = "Fifth subtitle"
    subtitles(5) = "Sixth subtitle"
    
    Timer1.Interval = 5000
    
    ' Make sure we are top of application's Z order
    SetWindowPos Me.Hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

' Example of dealing with form resize
Private Sub Form_Resize()
    Form1.Move Me.Left, Me.Top, Me.Width, Me.Height
    DisplaySubtitle "Ooh, I just resized ...", RGB(255, 0, 0)
End Sub

Private Function DisplaySubtitle(strOut As String, Optional NewFillColor As Long = &HFFFFFF)
    With Form2
        .Cls
        .FillColor = NewFillColor

        BeginPath .hdc
            Form2.ScaleMode = vbPixels
            Form2.CurrentY = Me.ScaleHeight - TextHeight(strOut)
            Form2.CurrentX = (Me.ScaleWidth - TextWidth(strOut)) / 2
            Form2.Print strOut
        EndPath .hdc
        StrokeAndFillPath .hdc
    End With
End Function

' Cycle through example subtitles
Private Sub Timer1_Timer()
    Static WhichSubtitle
    DisplaySubtitle subtitles(WhichSubtitle)
    WhichSubtitle = (WhichSubtitle + 1) Mod 6
End Sub[/blue]

 

[strongm]

Was this of any use, Ted?

 

[tedsmith]

I'm going north to the Great Barrier Reef for about 3 weeks (before global warming from the northern hemisphere kills all our coral)
I'll try it when I get back.
Cheers

 

[strongm]

Ah - making proper use of your 'retirement'. Enjoy.

 

[strongm]

Are you back?

 

[strongm]

Did this help?

 

[JAG14]

Unfortunately Mike, It appears Ted has decided to permanently retire on the reef.
He may be back when the Coral is killed off. But Missy (The Waitress at the Barrier Inn) may divorce him and take his computer in the settlement before then.

JaG

[Note to Mrs. Smith, this is Tongue in Cheek] :-D
[Note to Mike, I hope Mrs. Smith isn't an assassin.]
[Note to Moderators, Please make sure my address is not available to other users. including Mrs. Smith]

[tt]'Very funny, Scotty... Now Beam down my clothes.'[/tt]
​

 

[tedsmith]

No thanks for your deep concern but I just haven't got back to addressing my pending questions as yet.
(puts gin and tonic on side table)
The wife has coerced me into renovating the upstairs bathroom!

One interesting point would be whether a program written in VB6 or Net or c# takes more or less computer power and therefore electricity to run. Which would produce more greenhouse gases and so hasten the killing of the coral by raising the ocean temperature faster?

This may however be more than offset by the hot air sometimes expressed on various forums these days not to mention the 30 million x 100 watt= 300 megawatts of computers running using the internet at any time throughout the world!