Lancer un exe dans un picturebox

Signaler
Messages postés
151
Date d'inscription
samedi 17 juillet 2004
Statut
Membre
Dernière intervention
11 mai 2012
-
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
bonjour les ami(e)s
une question simple que j'ai pas trouver de solution même en recherchant
je vous lancer une app.exe dans un picturebox avec des postion exacte left=0 et top=0
merci d'avance

Merci à l'équipe

7 réponses

Messages postés
96
Date d'inscription
mardi 18 août 2009
Statut
Membre
Dernière intervention
14 août 2013

salut,

dans une form
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 Declare Function ShowWindow Lib "user32" ( _
                 ByVal HWND As Long, _
                 ByVal param As Long) As Long
                 
                 Private Declare Function SetForegroundWindow Lib "user32" (ByVal HWND As Long) As Long
Dim hInst As Long
Dim HFentre As Long
Dim hWndApp As Long
Dim lRet As Long

Dim lgRetVal As Long
Dim R As RECT


Private Sub Command1_Click()
lRet =  MyShell(App.Path & "\CouleurVB.exe", vbNormalFocus)
If lRet <> 0 Then
SetForegroundWindow (lRet)
DoEvents
SendKeys lRet, True
Else
End If
SetParent lRet, Picture1.HWND
DoEvents
hWndApp = lRet
hInst = lRet
HFentre = lRet
TextHandle = lRet
lgRetVal = GetWindowRect(lRet, R)
toto = R.Right
toto1 = R.Bottom
HWNDTOP = 0
swpnozorder = 4
cx = 100
cy = 200
cWidth = Wzone 
cHeight = H
SetWindowPos lRet, HWNDTOP, cx, cy, toto, toto1, swpnozorder
Handle = lRet
PP = ShowWindow(Handle, 3)
NewNomNB = NewNomNB + 1
NewNom = SetText(lRet, "mon soft - (N° " & NewNomNB & ")")
End Sub

Private Sub Form_Load()
NewNomNB = 0
End Sub









dans un module

Const SEE_MASK_DOENVSUBST  = &H200       ' Expand any environment variables specified in the string given by the lpDirectory or lpFile member.
Const SEE_MASK_FLAG_NO_UI = &H400       ' Do not display an error message box if an error occurs.
Const SEE_MASK_IDLIST = &H4             ' Use the item identifier list given by the lpIDList member. The lpIDList member must point
Const SEE_MASK_NOCLOSEPROCESS = &H40    ' Use to indicate that the hProcess member receives the process handle. This handle is typically
 
Private Type SHELLEXECUTEINFO
    cbSize          As Long
    fMask           As Long     ' Voir liste des constantes SEE_ ci-dessus
    HWND            As Long
    lpVerb          As String   ' Action à mener : edit, explore, find, open, print, properties
    lpFile          As String
    lpParameters    As String
    lpDirectory     As String
    nShow           As Long     ' Voir liste des constantes de VbAppWinStyle
    hInstApp        As Long     ' Voir liste des constantes SE_ ci-dessus
    lpIDList        As Long
    lpClass         As String
    hkeyClass       As Long
    dwHotKey        As Long
    hIcon           As Long
    hProcess        As Long     ' Si <> 0, ProcessId de l'instance créée (avec GetProcessId)
End Type

Public Declare Function GetWindowRect Lib "user32" (ByVal HWND As Long, lpRect As RECT) As Long

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type GUITHREADINFO
    cbSize As Long
    flags As Long
    hwndActive As Long
    hwndFocus As Long
    hwndCapture As Long
    hwndMenuOwner As Long
    hwndMoveSize As Long
    hwndCaret As Long
    rcCaret As RECT
End Type
Private Declare Function ShellExecuteEx Lib "shell32.dll" (SEI As SHELLEXECUTEINFO) As Long
Private Declare Function GetProcessId Lib "kernel32" (ByVal hProcessId As Long) As Long
Private Declare Function GetGUIThreadInfo Lib "user32" (ByVal dwthreadid As Long, lpguithreadinfo As GUITHREADINFO) As Long
Private Const GW_HWNDNEXT As Long = 2
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal HWND As Long, ByVal wCmd As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal HWND As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal HWND As Long, lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const WAIT_TIMEOUT As Long = 258&
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
'
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, _
                        ByVal hWndNewParent As Long) As Long
                        
  'internet
Private Declare Function InternetGetConnectedState Lib "Wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long

Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias _
      "GetWindowLongA" (ByVal HWND As Long, ByVal nIndex _
      As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias _
      "SetWindowLongA" (ByVal HWND As Long, ByVal nIndex _
      As Long, ByVal dwNewLong As Long) As Long

Public Declare Function GetSystemMenu Lib "user32" (ByVal _
      HWND As Long, ByVal bRevert As Long) As Long

Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu _
      As Long, ByVal nPosition As Long, ByVal wFlags As Long) _
      As Long

Public Declare Function GetMenuItemCount Lib "user32" (ByVal _
      hMenu As Long) As Long

Public Declare Function DrawMenuBar Lib "user32" (ByVal HWND _
      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

Private Const WM_GETTEXT = &HD
Private Const WM_SETTEXT = &HC

Public Const GWL_STYLE = (-16)

Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_THICKFRAME = &H40000

Public Const SC_CLOSE = &HF060
Public Const SC_MAXIMIZE = &HF030
Public Const SC_MINIMIZE = &HF020
Public Const SC_MOVE = &HF010
Public Const SC_RESTORE = &HF120

Public Const MF_BYCOMMAND = &H0
Public Const MF_BYPOSITION = &H400
Public Const MF_REMOVE = &H1000&

Public Function IsNetConnectOnline() As Boolean
IsNetConnectOnline = InternetGetConnectedState(0&, 0&)
End Function

Public Function active()
Dim activation
activation = "Code d'activation correct."
End Function

Public Function MyShell(ByRef sFichier As String, _
                        ByVal xStyle As VbAppWinStyle) As Long
    Dim SEI As SHELLEXECUTEINFO
    Dim lRet As Long
    Dim lProcID As Long
    Dim lAppHwnd As Long

    With SEI
        .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_FLAG_NO_UI Or SEE_MASK_DOENVSUBST Or SEE_MASK_IDLIST
        .HWND = 0
        .lpVerb = "open"
        .lpFile = sFichier
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = xStyle
        .hInstApp = 0
        .lpIDList = 0
        .cbSize = LenB(SEI)
    End With
    lRet = ShellExecuteEx(SEI)
    If lRet = 0 Then GoTo Sortie
    lProcID = GetProcessId(SEI.hProcess)
    If lProcID = 0 Then GoTo Sortie

    Do While lAppHwnd 0 And (WaitForSingleObject(SEI.hProcess, 200) WAIT_TIMEOUT)
        lAppHwnd = InstanceToWnd(lProcID)
        DoEvents
    Loop
    If lAppHwnd = 0 Then GoTo Sortie
    MyShell = lAppHwnd
Sortie:
    If SEI.hProcess > 0 Then CloseHandle SEI.hProcess
End Function

Private Function InstanceToWnd(ByVal lTarget_pid As Long) As Long
    Dim lTest_hwnd As Long, lTest_pid As Long, lTest_thread_id As Long
    lTest_hwnd = FindWindow(vbNullString, vbNullString)
    Do While lTest_hwnd <> 0
        If GetParent(lTest_hwnd) = 0 Then
            lTest_thread_id = GetWindowThreadProcessId(lTest_hwnd, lTest_pid)
            If lTest_pid = lTarget_pid Then
                If IsActiveWindowInThread(lTest_thread_id, lTest_hwnd) Then
                    InstanceToWnd = lTest_hwnd

                    Exit Do
                End If
            End If
        End If
        DoEvents
        lTest_hwnd = GetWindow(lTest_hwnd, GW_HWNDNEXT)
    Loop
End Function

Private Function IsActiveWindowInThread(lThreadId As Long, lHandleToCompare) As Boolean
    Dim lThrdInfo As GUITHREADINFO
    lThrdInfo.cbSize = LenB(lThrdInfo)
    If GetGUIThreadInfo(lThreadId, lThrdInfo) Then
        If lThrdInfo.hwndActive lHandleToCompare Then IsActiveWindowInThread True
    End If
End Function

Public Function GetText(HWND As Long) As String
Dim Txt As String
Txt = Space$(255)
SendMessage HWND, WM_GETTEXT, 255&, ByVal Txt
GetText = Txt
End Function

Public Function SetText(HWND As Long, Text As String) As Long
SetText = SendMessage(HWND, WM_SETTEXT, 0&, ByVal Text)
End Function
Messages postés
13
Date d'inscription
dimanche 5 novembre 2006
Statut
Membre
Dernière intervention
17 mars 2013

j'ai repris ce programme pour lancer Internet explorer dans une feuille fille.(ça marche)
J'ai pour objectif de piloter explorer sans le controle webBrowser, pour pouvoir bénéficier des cookies.
j'ai remplacé
"lRet = MyShell("C:\Program Files\Internet Explorer\iexplore.exe", vbNormalFocus)"
qui retourne l'ID du proces
par
[b] Set MyIE = CreateObject("InternetExplorer.Application")
MyIE.Application.Visible = True
'hwnd de la fenetre explorer
Hfentre = MyIE.Parent.hwnd
'pour retrouver l'id du proces
lRet = ProcIDFromWnd(Hfentre)/b
j'ai conservé la suite du programme:
SetParent lRet, Picture1.hwnd
........

Explorer se lance dans une fenêtre, mais plus dans le picturebox d'avant ma modif...
ou est l'erreur?...
Toute subjection serait la bienvenue...
MERCI



lebriou
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
220
Bonjour,
Là, déjà (sans préjudice du reste) :
SetParent lRet, Picture1.hwnd
puisque la fonction SetParent attend le Hwnd de la fenêtre à héberger, ce que n'est pas Lret

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messages postés
13
Date d'inscription
dimanche 5 novembre 2006
Statut
Membre
Dernière intervention
17 mars 2013

Si j'ai bien compris, Setparent à 2 paramètres:
Lret qui est l'id du process
Picture1.hwnd qui est le Hwnd de la fenêtre.

Dans le programme qui fonctionne, Lret est le retour de la fonction MyShell, qui devrait (d'après moi) être l'id du process.
voir lignes didine13 au dessus
Que retourne Myshell l'id du process ou ????
Est-ce la mon erreur?

lebriou
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
220
1) Je te rappelle avant tout que pour que ce type de code fonctionne, il est nécessaire que soient fermées toutes les instances en cours de IE
2) essaye donc ceci, bien plus simple :
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long

Const GW_HWNDNEXT = 2

Dim mWnd As Long

Private Sub Form_Activate()
    Dim Pid As Long
    LockWindowUpdate GetDesktopWindow
    'ici son exécutable ou assimilé
    Pid = Shell("C:\Program Files\Internet Explorer\iexplore.exe", vbNormalFocus)
    If Pid = 0 Then MsgBox "Erreur / démarrage de l'application"
    mWnd = InstanceToWnd(Pid)
    SetParent mWnd, Picture1.hwnd
    Putfocus mWnd
    LockWindowUpdate False
End Sub

Function InstanceToWnd(ByVal target_pid As Long) As Long
    Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
    Do While test_hwnd <> 0
        If GetParent(test_hwnd) = 0 Then
            test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
            If test_pid = target_pid Then
                InstanceToWnd = test_hwnd
                Exit Do
            End If
        End If
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function
 
Private Sub Form_Unload(Cancel As Integer)
    DestroyWindow mWnd
End Sub


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Messages postés
13
Date d'inscription
dimanche 5 novembre 2006
Statut
Membre
Dernière intervention
17 mars 2013

Merci pour cette réponse, en effet c' est beaucoup plus simple, mais mon objectif est
1° de lancer internet explorer dans une fenêtre(via un picturebox)
2° récupérer l'Object tel que celui crée par Set MyIE = CreateObject("InternetExplorer.Application")
pour pouvoir accéder à MyEI.Document. tout en bénéficiant des cookies

Actuellement, je développe un programme qui récupère les données, les met sous forme de fichier ".GED" exploitable dans les logiciels de généalogie grâce à un contrôle webBrowser. Cet objectif est atteint mais je ne bénéficie pas des cookies qui enregistrent les noms recherchés d'une cession à l'autre.


En un mot je cherche à reconstituer les fonctionnalités du controle webBrowser, tout en bénéficiant des cookies.




lebriou
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
220
Bien, mais on s'écarte là de ta demande, qui était d'ouvrir la fenêtre IE dans ta picturebox (ce que fait le code montré) !


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.