none
Translation code:Riproduzione avi file in una picture box da file .dll .ocx ed altri da vb6 a visual basic 10 express

    Domanda

  • Nessuno sa tradurre questo codice da vb6 a vb 10 express:

    Lanciare vb 6 aggiungere una picture box e un modulo.

    copiare questo a livello di codice in form1:

    Private Sub Form_Load()

      Dim sFileName As String, resID As Long, ret As Boolean
      Picture1.Cls
            sFileName = "setupapi.dll": resID = "60"
            'usare resource hunter o similari per visualizzare tutti i possibili video ed il loro id  presenti dentro i file .dll.ocx etc...
            'transparent using comdlg32.ocx (Picture1.hWnd, sFileName, resID, false o 1 true centrata o no,false o 1 o true autoplay o no,false o 1 o true,1 o true trasparente falseo non trasparente)
         ret = PlayAviCtrl(Picture1.hWnd, sFileName, resID, True, True, True)
      If ret = False Then 'file risorsa non trovato
        MsgBox "Unable to play this AVI"
        Picture1.Print "Unable to play this AVI"
        End If
    'StopAviCtrl
       
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
       
       StopAviCtrl
    End Sub



    Copiare quanto segue in module aggiunto prima:

    Private Type RECT   '  16  Bytes
         left As Long
         top As Long
         right As Long
         bottom As Long
    End Type
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    ' Window Styles
    Private Const WS_CHILD = &H40000000
    Private Const WS_VISIBLE = &H10000000
    Private Type tagInitCommonControlsEx
            dwSize As Long
            dwICC As Long
    End Type
    Private Declare Sub InitCommonControls Lib "Comctl32.dll" ()
    Private Declare Function InitCommonControlsEx Lib "Comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
    Private Const WM_USER = &H400
    Private Const ICC_ANIMATE_CLASS = &H80
    Private Const ANIMATE_CLASSA = "SysAnimate32"

    Private Const ACS_CENTER = &H1
    Private Const ACS_TRANSPARENT = &H2
    Private Const ACS_AUTOPLAY = &H4
    Private Const ACS_TIMER = &H8

    Private Const ACM_OPEN = (WM_USER + 100)
    Private Const ACM_PLAY = (WM_USER + 101)
    Private Const ACM_STOP = (WM_USER + 102)
    Dim bInit As Boolean
    Dim hAVI As Long
    Dim hModule As Long

    Public Function PlayAviCtrl(ByVal hParent As Long, ByVal sFileName As String, Optional ResourceID As Long = 0, Optional bCenter As Boolean = True, Optional bAutoPlay = True, Optional bTransparent As Boolean = True) As Boolean
      Dim lStyle As Long, ret As Long
      On Error GoTo ErrPlay
      If Not bInit Then Call InitComctl32(ICC_ANIMATE_CLASS)
      lStyle = WS_CHILD Or WS_VISIBLE
      If bAutoPlay Then lStyle = lStyle Or ACS_AUTOPLAY
      If bTransparent Then lStyle = lStyle Or ACS_TRANSPARENT
      If hAVI Then DestroyWindow (hAVI)
      If ResourceID = 0 Then
         hAVI = CreateWindowEx(0, ANIMATE_CLASSA, vbNullString, lStyle, 0, 0, 0, 0, hParent, 0&, App.hInstance, ByVal 0&)
         ret = SendMessage(hAVI, ACM_OPEN, 0, ByVal sFileName)
      Else
         hModule = LoadLibrary(sFileName)
         If hModule = 0 Then GoTo ErrPlay
         hAVI = CreateWindowEx(0, ANIMATE_CLASSA, vbNullString, lStyle, 0, 0, 0, 0, hParent, 0&, hModule, ByVal 0&)
         ret = SendMessage(hAVI, ACM_OPEN, 0, ByVal ResourceID)
      End If
      If ret = 0 Or hAVI = 0 Then GoTo ErrPlay
      If bCenter Then Call CenterAVI(hParent)
      Call SendMessage(hAVI, ACM_PLAY, -1, ByVal 0&)
      PlayAviCtrl = True
      Exit Function
    ErrPlay:
      If hModule Then Call FreeLibrary(hModule)
      Call DestroyWindow(hAVI)
    End Function

    Public Sub StopAviCtrl()
      If hAVI Then
         Call SendMessage(hAVI, ACM_STOP, 0, ByVal 0&)
         Call SendMessage(hAVI, ACM_OPEN, 0, ByVal 0&)
         Call DestroyWindow(hAVI)
      End If
      If hModule Then Call FreeLibrary(hModule)
    End Sub

    Private Sub InitComctl32(dwFlags As Long)
     Dim icc As tagInitCommonControlsEx
      bInit = True
    On Error GoTo Err_OldVersion
    icc.dwSize = Len(icc)
     icc.dwICC = dwFlags
       InitCommonControlsEx icc
      On Error GoTo 0
       Exit Sub
    Err_OldVersion:
       InitCommonControls
    End Sub

    Private Sub CenterAVI(ByVal h As Long)
      Dim rcAVI As RECT, rcParent As RECT
      Call GetWindowRect(h, rcParent)
      Call GetWindowRect(hAVI, rcAVI)
      Call MoveWindow(hAVI, (rcParent.right - rcParent.left - rcAVI.right + rcAVI.left) / 2, (rcParent.bottom - rcParent.top - rcAVI.bottom + rcAVI.top) / 2, rcAVI.right - rcAVI.left, rcAVI.bottom - rcAVI.top, True)
    End Sub

    nessuno che ce la faccia a farlo funzionare in visual basic 10 express ne ho provate di tutti i colori ma non sono riuscito ad adattarlo da visual basic 6 a visual basic 10.

    Grazie in anticipo.

    venerdì 13 luglio 2018 12:05

Tutte le risposte