Simultaneous PowerPoints on a vb form

[JJinTXs]

I wrote an application that has 3 frames on it. Frame 1 shows a powerpoint show, Frame2 pulls data from a database and loads it into labels, Frame3 pulls a second powerpoint. Each frame is displayed on a separate monitor.

The problem I am having is controlling the slide transitions of powerpoint. If the slide show, with multiple slides, loops and transitions from slide to slide, ONLY the slideshow that had focus last will transition. If I click on the first slide show, then it will transition and the previous show stops transitioning. Can anyone suggest a method to make both shows transition simultaneously?

Here's some quick and nasty code that does 2 powerpoints like i do in my project. Obviously the .AdvanceTime = 0.000015 will make each slide scream by but that's not the point. The point is, I'm stuck and need help. A quick solution I used was to publish the powerpoint as a flash, the insert the flash back into a single slide. Then, the new problem is that no matter what settings are set in powerpoint of flash timing, the slides transition at 8 seconds. If anyone is interested here is the freeware to publish powerpoint into flash.

http://www.ispringsolutions.com/free...converter.html

I'm not endorsing the above, it was a temporary solution. Now I need your help.


'In a module
Option Explicit

Const APP_NAME = "PowerPoint in VB window"

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Public screenClasshWnd As Long
Public oPPTApp1 As PowerPoint.Application
Public oPPTPres1 As PowerPoint.Presentation
Public oPPTPres2 As PowerPoint.Presentation

Sub main()

Form2.Show

End Sub


'In the form
Option Explicit

Private iIndex As Integer

Private Sub Form_Load()
Dim lleft As Single
Dim ttop As Single
Dim wwidth As Single
Dim hheight As Single

lleft = 0
ttop = 0
wwidth = 512 * 15
hheight = 768 * 15

GetPPTs
Me.Move lleft, ttop, wwidth, hheight
End Sub
Private Sub GetPPTs()
Dim numOfSlides As Integer
Dim i As Integer

Set oPPTApp1 = New Application


If Not oPPTApp1 Is Nothing Then
Set oPPTPres1 = oPPTApp1.Presentations.Open("C:\Temp\Visual Board.ppt", True, , False)
With oPPTPres1
.SlideShowSettings.Run
screenClasshWnd = FindWindow("screenClass", 0&)
SetParent screenClasshWnd, frmSS1.hwnd
numOfSlides = .Slides.Count
For i = 1 To numOfSlides
.Slides.Range.SlideShowTransition.AdvanceOnTime = True
.Slides.Range.SlideShowTransition.AdvanceTime = 0.000015
.SlideShowSettings.Run
Next i
End With
End If
If Not oPPTApp1 Is Nothing Then
Set oPPTPres2 = oPPTApp1.Presentations.Open("C:\Temp\Visual Board.ppt", True, , False)
With oPPTPres2
.SlideShowSettings.Run
screenClasshWnd = FindWindow("screenClass", 0&)
SetParent screenClasshWnd, frmSS1.hwnd
numOfSlides = .Slides.Count
For i = 1 To numOfSlides
.Slides.Range.SlideShowTransition.AdvanceOnTime = True
.Slides.Range.SlideShowTransition.AdvanceTime = 0.000015
.SlideShowSettings.Run
Next i
End With
End If



End Sub




Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Not oPPTPres1 Is Nothing Then
Set oPPTPres1 = Nothing
End If
If Not oPPTApp1 Is Nothing Then
oPPTApp1.Quit
Set oPPTApp1 = Nothing
End If

End Sub

[vb5prgrmr]

Okay, this seems to be the problem of VB's single threading apartment model in that you say as long as the form has focus it works and I need to change the focus to the other form for it to transition. It also looks like from your example that the calls to transition are blocking or synchronous and if this is so then, I don't know what to tell you beyond the CreateThread API.

BUT, there might be a solution using the timer control...

To use example start new standard exe project>add command button>add timer control>paste code>run>click button

Option Explicit

Dim MyCounter As Integer

Private Sub Form_Load()
Me.AutoRedraw = True
Me.FontSize = 20
Me.FontBold = True
End Sub

Private Sub Command1_Click()
Dim NF As Form

Me.Left = (Screen.Width / 2) - (Me.Width / 2)
Me.Top = (Screen.Height / 2) - (Me.Height / 2)

Set NF = New Form1
Load NF
NF.Left = 0
NF.Top = 0
NF.Timer1.Interval = 250
NF.Timer1.Enabled = True
NF.Show

Set NF = New Form1
Load NF
NF.Left = Screen.Width - Me.Width
NF.Top = 0
NF.Timer1.Interval = 250
NF.Timer1.Enabled = True
NF.Show

Set NF = New Form1
Load NF
NF.Left = 0
NF.Top = Screen.Height - Me.Height
NF.Timer1.Interval = 250
NF.Timer1.Enabled = True
NF.Show

Set NF = New Form1
Load NF
NF.Left = Screen.Width - Me.Width
NF.Top = Screen.Height - Me.Height
NF.Timer1.Interval = 250
NF.Timer1.Enabled = True
NF.Show

End Sub

Private Sub Timer1_Timer()
Me.Cls
Print MyCounter
MyCounter = MyCounter + 1
If MyCounter > 1000 Then MyCounter = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim F As Form
For Each F In Forms
  Unload F
Next
End Sub

Just a couple of thoughts...

Good Luck

[JJinTXs]

Well, that didn't quite work. I think it is safe to say that VB is limited in this aspect. I believe my solution lies within Flash. It works seemless except for the timing. I'll pursue getting it to work as needed. Thanks for looking at this!

J

[dglienna]

VB.Net allows you to multi-task

[JJinTXs]

Thanks dglienna, unfortunately I don't have the compiler at my place of employment.

J

[vb5prgrmr]

Example of multithreading in VB6 by strongm from http://www.tek-tips.com ...


Mwahahah! Here's some example code that illustrates the idea...

You'll need a form with a single button, and the following code:

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Command3_Click()
    Dim hThread As Long
    Dim a As New Wombat
    Dim b As New Wombat
    Dim starttime As Long
    
    ' techniqe that blocks
    starttime = GetTickCount
    oResponse1 = a.FiveSecs
    oResponse2 = b.TenSecs
    Debug.Print GetTickCount - starttime
    
    Debug.Print "Both calls now finished..."
    oResponse1 = 0
    oResponse2 = 0
    
    ' Horrendous thread-based technique that doesn't block...
    starttime = GetTickCount
    hThread = CreateThread(ByVal 0&, ByVal 0&, AddressOf FiveSecs, ByVal 0&, ByVal 0&, 0&) ' hThreadID)
    ' Don't need handle, so dispose of it cleanly
    CloseHandle hThread
    hThread = CreateThread(ByVal 0&, ByVal 0&, AddressOf TenSecs, ByVal 0&, ByVal 0&, 0&) ' hThreadID)
    ' Don't need handle, so dispose of it cleanly
    CloseHandle hThread
    Do Until oResponse1 <> 0 And oResponse2 <> 0
        DoEvents
    Loop
    Debug.Print GetTickCount - starttime
    
    Debug.Print "Both threads now finished..."
    oResponse1 = 0
    oResponse2 = 0
End Sub

And a module containing the following:

Option Explicit

Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public oResponse1 As Long
Public oResponse2 As Long

Public Sub FiveSecs()
    Dim a As New Wombat
    oResponse1 = a.FiveSecs

End Sub


Public Sub TenSecs()
    Dim b As New Wombat
    oResponse2 = b.TenSecs
End Sub

And, for the example, a class module (my class is imaginatively called 'Wombat') with the following code:

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Function TenSecs() As Long
    Dim starttime As Long
    starttime = GetTickCount
    Do Until GetTickCount - starttime >= 10000
    Loop
    TenSecs = 10
End Function


Public Function FiveSecs() As Long
    Dim starttime As Long
    starttime = GetTickCount
    Do Until GetTickCount - starttime >= 5000
    Loop
   FiveSecs = 5
End Function

As per my CreateThread API suggestion from my prior post.

Have fun!

Good Luck

[dglienna]

Doesn't help with Duel-Core or better, and I wouldn't bet that it runs with a full processor load...

[vb5prgrmr]

It runs with second app eating cpu in doevents every 10,000 iterations. Duel core should only help it out (if duel core actually lived up to the hype, which it doesn't).

[dglienna]

VB6 only uses one core, anyways