Sujet Précédent Sujet Suivant

Choix d'imprimante

cs_tekanerahtatase Messages postés 22 Date d'inscription mercredi 17 octobre 2007 Statut Membre Dernière intervention 31 janvier 2011 - 29 janv. 2011 à 18:16
cs_didine13 Messages postés 96 Date d'inscription mardi 18 août 2009 Statut Membre Dernière intervention 14 août 2013 - 16 févr. 2011 à 12:33
Bonjour,

J'aimerais savoir comment je pourrais afficher un choix d'imprimante dans une application VB6. ou mieux encore, définir une imprimante seulement pour cette application.

Merci de votre aide...


 Jean-François

2 réponses

Réponse 1 / 2
cs_didine13 Messages postés 96 Date d'inscription mardi 18 août 2009 Statut Membre Dernière intervention 14 août 2013
16 févr. 2011 à 12:31
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
0
Réponse 2 / 2
cs_didine13 Messages postés 96 Date d'inscription mardi 18 août 2009 Statut Membre Dernière intervention 14 août 2013
16 févr. 2011 à 12:33
désoler je me suit tromper de sujet
http://www.vbfrance.com/forum/sujet-LANCER-EXE-DANS-PICTUREBOX_1491074.aspx
0

Discussions similaires

Imprimante Virtuelle: Impression dans un fichier
themaste -
Xaviou -

1 réponse
Impression de fichier .txt
cs_redbar -
cs_redbar -

10 réponses
IMPRIMANTE VIRTUELLE
bouv -
lesdis -

8 réponses
choix imprimante sous QR
xantro -
tewprog -

9 réponses
Créer une imprimante virtuelle ?
cs_locas -
locas -

2 réponses
Rejoignez-nous