Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Gestion image WebCam ???

2 réponses
Avatar
LE TROLL
Bonjour,

Dans le code qui suit, que j'ai recopié sur la faq vb, j'ai bien une
image de WenCam, mais je n'arrive pas à réduire ou à agrandir l'image,
enfin, si, mais ça ne réduit pas celle de la caméra, alors voyez-vous s'il y
a des paramètres qui me permettraient de régler la taille de l'image ???

Je voudrais aussi enregistrer les images en tant que film, savez-vous
comment.

In fine, je cherche aussi à en faire un détecteur de mouvement
(comparaison de deux images), qui renvoie à la question sus-citée.

Merci de vos lumières :o)

----------------------------------CODE

' form1 : écran de webcam
'
' form1 + picture1
'
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 capCreateCaptureWindow Lib "avicap32.dll" Alias
"capCreateCaptureWindowA" ( _
ByVal lpszWindowName 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 nID As Long) As Long
'
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA"
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
'
Private Declare Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
'
Const WM_USER As Long = &H400
Const WM_CAP_DRIVER_CONNECT As Long = WM_USER + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Const WM_CAP_GRAB_FRAME As Long = WM_USER + 60
Const WM_CAP_EDIT_COPY As Long = WM_USER + 30
Const Flags = &H2 Or &H1 Or &H40 Or &H10
'
Dim iResult As Long
Dim Resultat As Long
'

Sub Form_Load() ' lancement
m_pp.Checked = False
m_ap.Checked = True
Timer1.Interval = 40
iResult = capCreateCaptureWindow("Capture", 0, 0, 0, Picture1.ScaleWidth,
Picture1.ScaleHeight, Me.hwnd, 0)
SendMessage iResult, WM_CAP_DRIVER_CONNECT, 0, 0
End Sub

Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y
As Single)
If Button = 1 Then ' commande souris
Call ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
If Button = 2 Then: PopupMenu m_pop
End Sub

Sub Timer1_Timer() ' balayage image
Clipboard.Clear
SendMessage iResult, WM_CAP_GRAB_FRAME, 0, 0
SendMessage iResult, WM_CAP_EDIT_COPY, 0, 0
Picture1.Picture = Clipboard.GetData
End Sub

Sub m_pp_Click() ' 1er plan
m_pp.Checked = True
m_ap.Checked = False
Resultat = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, Flags)
End Sub

Sub m_ap_Click() ' arrière plan
m_pp.Checked = False
m_ap.Checked = True
Resultat = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, Flags)
End Sub

Sub m_close_Click() ' fermer l'écran
Dim cancel As Integer
Call Form_Unload(cancel)
End Sub

Sub Form_Unload(cancel As Integer) ' terminer
SendMessage iResult, WM_CAP_DRIVER_DISCONNECT, 0, 0
Resultat = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, Flags)
Timer1.Enabled = False
Unload Form1
End
End Sub
------------------FIN

--
Merci beaucoup, au revoir et à bientôt :o)
------
Site de MES LOGICIELS
http://irolog.free.fr
Site éditeur de MES ROMANS édités
http://irolog.free.fr/romans
mon adresse EMail
http://irolog.free.fr/ecrire/index.htm
------------------------------------------------------------------------------------

2 réponses

Avatar
David
Bonjour Le Troll,

J'ai dans mes archives un programme source qui a l'air de faire
tout ce qui tu veux faire, trouvé en son temps sur la toile.
Mais j'y comprends rien dans ce type de code (je suis plus
orienté math et compta) !!
Je veux bien t'envoyer toute la source à ton adresse e-mail
que tu me communiqueras.

a+
jean-pol DAVID


"LE TROLL" <le a écrit dans le message de news:
%
Bonjour,

Dans le code qui suit, que j'ai recopié sur la faq vb, j'ai bien une
image de WenCam, mais je n'arrive pas à réduire ou à agrandir l'image,
enfin, si, mais ça ne réduit pas celle de la caméra, alors voyez-vous s'il
y a des paramètres qui me permettraient de régler la taille de l'image ???

Je voudrais aussi enregistrer les images en tant que film, savez-vous
comment.

In fine, je cherche aussi à en faire un détecteur de mouvement
(comparaison de deux images), qui renvoie à la question sus-citée.

Merci de vos lumières :o)

----------------------------------CODE

' form1 : écran de webcam
'
' form1 + picture1
'
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 capCreateCaptureWindow Lib "avicap32.dll" Alias
"capCreateCaptureWindowA" ( _
ByVal lpszWindowName 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 nID As Long) As Long
'
Private Declare Function SendMessage Lib "user32.dll" Alias
"SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
'
Private Declare Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
'
Const WM_USER As Long = &H400
Const WM_CAP_DRIVER_CONNECT As Long = WM_USER + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Const WM_CAP_GRAB_FRAME As Long = WM_USER + 60
Const WM_CAP_EDIT_COPY As Long = WM_USER + 30
Const Flags = &H2 Or &H1 Or &H40 Or &H10
'
Dim iResult As Long
Dim Resultat As Long
'

Sub Form_Load() ' lancement
m_pp.Checked = False
m_ap.Checked = True
Timer1.Interval = 40
iResult = capCreateCaptureWindow("Capture", 0, 0, 0, Picture1.ScaleWidth,
Picture1.ScaleHeight, Me.hwnd, 0)
SendMessage iResult, WM_CAP_DRIVER_CONNECT, 0, 0
End Sub

Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y
As Single)
If Button = 1 Then ' commande souris
Call ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
If Button = 2 Then: PopupMenu m_pop
End Sub

Sub Timer1_Timer() ' balayage image
Clipboard.Clear
SendMessage iResult, WM_CAP_GRAB_FRAME, 0, 0
SendMessage iResult, WM_CAP_EDIT_COPY, 0, 0
Picture1.Picture = Clipboard.GetData
End Sub

Sub m_pp_Click() ' 1er plan
m_pp.Checked = True
m_ap.Checked = False
Resultat = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, Flags)
End Sub

Sub m_ap_Click() ' arrière plan
m_pp.Checked = False
m_ap.Checked = True
Resultat = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, Flags)
End Sub

Sub m_close_Click() ' fermer l'écran
Dim cancel As Integer
Call Form_Unload(cancel)
End Sub

Sub Form_Unload(cancel As Integer) ' terminer
SendMessage iResult, WM_CAP_DRIVER_DISCONNECT, 0, 0
Resultat = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, Flags)
Timer1.Enabled = False
Unload Form1
End
End Sub
------------------FIN

--
Merci beaucoup, au revoir et à bientôt :o)
------
Site de MES LOGICIELS
http://irolog.free.fr
Site éditeur de MES ROMANS édités
http://irolog.free.fr/romans
mon adresse EMail
http://irolog.free.fr/ecrire/index.htm
------------------------------------------------------------------------------------




Avatar
LE TROLL
Salut,

Merci, oui, ben mon adresse est indiqué en bas :o)

Mais moi non plus je n'y comprends rien...

Cordialement.

--
Merci beaucoup, au revoir et à bientôt :o)
------
Site de MES LOGICIELS
http://irolog.free.fr
Site éditeur de MES ROMANS édités
http://irolog.free.fr/romans
mon adresse EMail
http://irolog.free.fr/ecrire/index.htm
------------------------------------------------------------------------------------
"David" a écrit dans le message de news:

Bonjour Le Troll,

J'ai dans mes archives un programme source qui a l'air de faire
tout ce qui tu veux faire, trouvé en son temps sur la toile.
Mais j'y comprends rien dans ce type de code (je suis plus
orienté math et compta) !!
Je veux bien t'envoyer toute la source à ton adresse e-mail
que tu me communiqueras.

a+
jean-pol DAVID


"LE TROLL" <le a écrit dans le message de news:
%
Bonjour,

Dans le code qui suit, que j'ai recopié sur la faq vb, j'ai bien une
image de WenCam, mais je n'arrive pas à réduire ou à agrandir l'image,
enfin, si, mais ça ne réduit pas celle de la caméra, alors voyez-vous
s'il y a des paramètres qui me permettraient de régler la taille de
l'image ???

Je voudrais aussi enregistrer les images en tant que film, savez-vous
comment.

In fine, je cherche aussi à en faire un détecteur de mouvement
(comparaison de deux images), qui renvoie à la question sus-citée.

Merci de vos lumières :o)

----------------------------------CODE

' form1 : écran de webcam
'
' form1 + picture1
'
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 capCreateCaptureWindow Lib "avicap32.dll" Alias
"capCreateCaptureWindowA" ( _
ByVal lpszWindowName 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 nID As Long) As Long
'
Private Declare Function SendMessage Lib "user32.dll" Alias
"SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
'
Private Declare Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
'
Const WM_USER As Long = &H400
Const WM_CAP_DRIVER_CONNECT As Long = WM_USER + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Const WM_CAP_GRAB_FRAME As Long = WM_USER + 60
Const WM_CAP_EDIT_COPY As Long = WM_USER + 30
Const Flags = &H2 Or &H1 Or &H40 Or &H10
'
Dim iResult As Long
Dim Resultat As Long
'

Sub Form_Load() ' lancement
m_pp.Checked = False
m_ap.Checked = True
Timer1.Interval = 40
iResult = capCreateCaptureWindow("Capture", 0, 0, 0,
Picture1.ScaleWidth, Picture1.ScaleHeight, Me.hwnd, 0)
SendMessage iResult, WM_CAP_DRIVER_CONNECT, 0, 0
End Sub

Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single)
If Button = 1 Then ' commande souris
Call ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
If Button = 2 Then: PopupMenu m_pop
End Sub

Sub Timer1_Timer() ' balayage image
Clipboard.Clear
SendMessage iResult, WM_CAP_GRAB_FRAME, 0, 0
SendMessage iResult, WM_CAP_EDIT_COPY, 0, 0
Picture1.Picture = Clipboard.GetData
End Sub

Sub m_pp_Click() ' 1er plan
m_pp.Checked = True
m_ap.Checked = False
Resultat = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, Flags)
End Sub

Sub m_ap_Click() ' arrière plan
m_pp.Checked = False
m_ap.Checked = True
Resultat = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, Flags)
End Sub

Sub m_close_Click() ' fermer l'écran
Dim cancel As Integer
Call Form_Unload(cancel)
End Sub

Sub Form_Unload(cancel As Integer) ' terminer
SendMessage iResult, WM_CAP_DRIVER_DISCONNECT, 0, 0
Resultat = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, Flags)
Timer1.Enabled = False
Unload Form1
End
End Sub
------------------FIN

--
Merci beaucoup, au revoir et à bientôt :o)
------
Site de MES LOGICIELS
http://irolog.free.fr
Site éditeur de MES ROMANS édités
http://irolog.free.fr/romans
mon adresse EMail
http://irolog.free.fr/ecrire/index.htm
------------------------------------------------------------------------------------