تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
التقاط صورة وحفظها من الكاميرا
#1
Photo 

السلام عليكم نظرا لطلب أحد الأخوة في المنتدى وجدت هذا الكود
وأود طرحه بشكل عام لان ان يكون مجرد رد على مشاركة في موضوع في قسم
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/46...m-in-vb60/
سبحان الله والحمدلله ولا إله إلا الله والله أكبر
 رَبِّ اغْفِرْ لِي وَلِوَالِدَيَّ
Heart
الرد }}}}
تم الشكر بواسطة: سعود , Ahmed_Mansoor , عبد العزيز البسكري
#2
وعليك السلام ورحمة الله وبركاته

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


التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم