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 Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = &H400
Private Const WM_CAP_START = &H400
Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)
Private Preview_Handle 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 Function CapturePicture(nCaptureHandle As Long) As StdPicture
Clipboard.Clear
SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0
Set CapturePicture = Clipboard.GetData
End Function
Private Sub Command1_Click()
CommonDialog1.Filter = “JPEG 图像|.jpg;|PNG 图像|.png;|BMP 图像|.bmp;|GIF 图像|.gif”
CommonDialog1.ShowSave
Dim selectedFile As String
selectedFile = CommonDialog1.FileName
If selectedFile <> "" Then
Dim fileExtension As String
fileExtension = Right(selectedFile, Len(selectedFile) - InStrRev(selectedFile, "."))
Select Case LCase(fileExtension)
Case "bmp"
SavePicture Picture2.Picture, selectedFile
Case "jpg"
SavePicture Picture2.Picture, selectedFile
Case "png"
SavePicture Picture2.Picture, selectedFile
Case "gif"
SavePicture Picture2.Picture, selectedFile
Case Else
MsgBox "不支持的图片格式!"
End Select
End If
End Sub
Private Sub Command2_Click()
Picture2.Picture = CapturePicture(Preview_Handle)
End Sub
Private Sub Form_Load()
Preview_Handle = capCreateCaptureWindow(“Video”, WS_CHILD + WS_VISIBLE, 2, 2, 1220, 1156, Picture1.hwnd, 1)
SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, 0, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 1, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
SendMessage Preview_Handle, WM_CAP_DRIVER_DISCONNECT, 0, 0
End Sub