j'ai trouvé ce bout de code qui permet de capturer une photo à partir
d'une WEBCAM. Associé à un Timer ca permet un Preview à la fréquence
qu'on veut. Peut_on se passer de l'étape de sauvegarde , couteuse en
BMP ?
merci.
Public Function MakePreview()
Call capGrabFrameNoStop(FrmMain.capwnd)
Call capFileSaveDIB(FrmMain.capwnd, App.path & "\picture.bmp")
picturebox = LoadPicture(App.path & "\picture.bmp")
Buffer.Picture = picturebox.Picture
End Function
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
LE TROLL
Bonjour,
Tiens, j'ai fait une webcam de surveillance, (sans enregistrement), mais je n'arrive pas à modifier la taille de l'image...
Si tu arrives à enregistrer, ou à faire une alerte de mouvement (par comparaison d'image), ou à modifier la taille, fais-moi signe par email (en bas)... --------------------------------- ci-joint aussi fichiers... ---------------------------------
' surveillance Webcam : 1 objet = picture 1 : form 1 ' 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
-- Romans, logiciels, email, site personnel http://irolog.free.fr/joe.htm ------------------------------------------------------------------------------------ "free" a écrit dans le message de news: 472d7db5$0$20095$ | bonjour , | | j'ai trouvé ce bout de code qui permet de capturer une photo à partir | | d'une WEBCAM. Associé à un Timer ca permet un Preview à la fréquence | | qu'on veut. Peut_on se passer de l'étape de sauvegarde , couteuse en | | BMP ? | | merci. | | Public Function MakePreview() | Call capGrabFrameNoStop(FrmMain.capwnd) | Call capFileSaveDIB(FrmMain.capwnd, App.path & "picture.bmp") | picturebox = LoadPicture(App.path & "picture.bmp") | Buffer.Picture = picturebox.Picture | End Function | |
begin 666 webcam.vbw M1F]R;3$@/2 T-"@L(# R+"!:+" M,C L(#$P+" U.3$L(#0U &-"* ` end
Bonjour,
Tiens, j'ai fait une webcam de surveillance,
(sans enregistrement), mais je n'arrive pas à
modifier la taille de l'image...
Si tu arrives à enregistrer, ou à faire une
alerte de mouvement (par comparaison d'image), ou
à modifier la taille, fais-moi signe par email (en
bas)...
---------------------------------
ci-joint aussi fichiers...
---------------------------------
' surveillance Webcam : 1 objet = picture 1 :
form 1
'
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
--
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"free" <charles.rayer@numericable.fr> a écrit dans
le message de news:
472d7db5$0$20095$426a34cc@news.free.fr...
| bonjour ,
|
| j'ai trouvé ce bout de code qui permet de
capturer une photo à partir
|
| d'une WEBCAM. Associé à un Timer ca permet un
Preview à la fréquence
|
| qu'on veut. Peut_on se passer de l'étape de
sauvegarde , couteuse en
|
| BMP ?
|
| merci.
|
| Public Function MakePreview()
| Call capGrabFrameNoStop(FrmMain.capwnd)
| Call capFileSaveDIB(FrmMain.capwnd, App.path
& "picture.bmp")
| picturebox = LoadPicture(App.path &
"picture.bmp")
| Buffer.Picture = picturebox.Picture
| End Function
|
|
Tiens, j'ai fait une webcam de surveillance, (sans enregistrement), mais je n'arrive pas à modifier la taille de l'image...
Si tu arrives à enregistrer, ou à faire une alerte de mouvement (par comparaison d'image), ou à modifier la taille, fais-moi signe par email (en bas)... --------------------------------- ci-joint aussi fichiers... ---------------------------------
' surveillance Webcam : 1 objet = picture 1 : form 1 ' 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
-- Romans, logiciels, email, site personnel http://irolog.free.fr/joe.htm ------------------------------------------------------------------------------------ "free" a écrit dans le message de news: 472d7db5$0$20095$ | bonjour , | | j'ai trouvé ce bout de code qui permet de capturer une photo à partir | | d'une WEBCAM. Associé à un Timer ca permet un Preview à la fréquence | | qu'on veut. Peut_on se passer de l'étape de sauvegarde , couteuse en | | BMP ? | | merci. | | Public Function MakePreview() | Call capGrabFrameNoStop(FrmMain.capwnd) | Call capFileSaveDIB(FrmMain.capwnd, App.path & "picture.bmp") | picturebox = LoadPicture(App.path & "picture.bmp") | Buffer.Picture = picturebox.Picture | End Function | |
