منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب
التقاط صورة وحفظها من الكاميرا - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغات البرمجة الاخرى (http://vb4arb.com/vb/forumdisplay.php?fid=4)
+--- قسم : قسم لغة vb6.0 (http://vb4arb.com/vb/forumdisplay.php?fid=18)
+---- قسم : قسم أمثلة ومشاريع vb6.0 (http://vb4arb.com/vb/forumdisplay.php?fid=30)
+---- الموضوع : التقاط صورة وحفظها من الكاميرا (/showthread.php?tid=17109)



التقاط صورة وحفظها من الكاميرا - أبو عمر - 01-09-16


السلام عليكم نظرا لطلب أحد الأخوة في المنتدى وجدت هذا الكود
وأود طرحه بشكل عام لان ان يكون مجرد رد على مشاركة في موضوع في قسم
ASP.NET
تضل الفيجوال بيسك 6
تتنفس أيضاً


PHP كود :
'هذا الكود في وحدة نمطية Module
Public Const WS_CHILD As Long = &H40000000
Public Const WS_VISIBLE As Long = &H10000000


Public Const WM_USER As Long = &H400
Public Const WM_CAP_START As Long = WM_USER



Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25







Public 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







Public Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long _
        , ByVal wParam As Long, ByRef lParam As Any) As Long


'
الكود التالي في الفورم مع مراعات التالي
Add the following controls in a form

1. A picture box with name 
"PicWebCam"
'اضافة صندوق صور واعيد تسميته
2. A commondialog control with name "CDialog"
'
اداة استعراض الملفات
3. Add 4 command buttons with name 
"cmd1","cmd2,"cmd3","cmd4"
'اربع زراير
then paste the following code
'انسخ الكود التالي للفورم

Dim hCap As Long
Private Sub cmd4_Click()
Dim sFileName As String
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
    With CDialog
        .CancelError = True
        .Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt
        .Filter = "
Bitmap Picture(*.bmp)|*.bmp|JPEG Picture(*.jpg)|*.jpg|All Files|*.*"
        .ShowSave
        sFileName = .FileName

    End With
    Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub

Private Sub Cmd3_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End Sub

Private Sub Cmd1_Click()
hCap = capCreateCaptureWindow("
Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.hWnd, 0)
    If hCap <> 0 Then
        Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If
End Sub


Private Sub Cmd2_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End Sub



Private Sub Form_Load()
cmd1.Caption = "
Start &Cam"
cmd2.Caption = "
&Format Cam"
cmd3.Caption = "
&Close Cam"
cmd4.Caption = "
&Save Image"
End Sub 

المصدر
http://www.developerfusion.com/thread/46191/how-to-capture-picture-using-webcam-in-vb60/


RE: التقاط صورة وحفظها من الكاميرا - Ahmed_Mansoor - 01-09-16

وعليك السلام ورحمة الله وبركاته

أهلا بك أخي أبوعمر , ألف شكرا جزيلا لك على الكود الرائع , جزاك الله كل خير .