Я вижу, что у вас возникли проблемы с настройкой кода самостоятельно, поэтому позвольте мне рассказать вам о процессе его настройки для VBA.
Сначала мы создадим форму, которая содержит код веб-камеры, и добавим в нее необходимые элементы управления. Управление:
4 кнопки, называемые cmd1, cmd2, cmd3 и cmd4, и 1 элемент управления подчиненной формы, называемый PicWebCam. Мы используем подчиненную форму для замены объекта PictureBox, поскольку он недоступен в Access.
Поскольку подчиненная форма должна что-то отображать, мы создаем вторую форму в режиме конструктора и устанавливаем селекторы записей и кнопки навигации в значение Нет. Мы не добавляем элементы управления в форму и делаем ее достаточно маленькой, чтобы в ней не было прокрутки. бары. Затем мы устанавливаем исходный объект нашего подчиненного элемента управления в форму, которую мы только что создали.
Затем в коде также используется элемент управления CommonDialog, позволяющий нам выбрать путь к файлу для сохранения изображения. Хотя это доступно для некоторых комбинаций Windows + Access, мы не можем полагаться на это, поэтому вместо этого будем использовать FileDialog.
Чтобы получить путь к файлу, мы добавляем следующий код в наш модуль формы:
Function GetSavePath() As String
Dim f As Object 'FileDialog
Set f = Application.FileDialog(2) 'msoFileDialogSaveAs
If f.Show <> 0 Then GetSavePath = f.SelectedItems(1)
End Function
Затем мы копируем и вставляем начальные объявления (типы и операторы объявления функций) и делаем 2 корректировки:
Поскольку мы собираемся поместить их в модуль формы, Public необходимо удалить для всего, что по умолчанию закрыто, и изменить на Private для вещей, которые не являются.
Поскольку мы хотим быть совместимыми с 64-битным Access (вы сказали, что вам это не нужно, но все равно добавляете его), мы хотим добавить ключевое слово PtrSafe ко всем внешним функциям и изменить тип для всех указателей от Long до LongPtr. Этот код предшествует функции, которую мы только что создали.
Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000
Const WM_USER As Long = &H400
Const WM_CAP_START As Long = WM_USER
Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25
Private Declare PtrSafe 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 LongPtr _
, ByVal nID As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long _
, ByVal wParam As Long, ByRef lParam As Any) As Long
Dim hCap As LongPtr
Теперь мы можем скопировать и вставить действительные функции и внести 2 изменения:
- Вместо обычного диалогового управляющего кода мы используем функцию
GetSavePath, чтобы получить путь, по которому пользователь хочет сохранить файл.
- Вместо
PicWebCam.hWnd мы используем PicWebCam.Form.hWnd, чтобы получить hWnd для кадра, который мы хотим заполнить подачей веб-камеры.
Private Sub cmd4_Click()
Dim sFileName As String
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
sFileName = GetSavePath
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.Form.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
Наконец, поскольку мы добавили обработчики событий для события Form_Load, нам нужно убедиться, что свойство On Load формы установлено в [Event Procedure]. То же самое касается свойства On Click всех добавленных нами командных кнопок.
И это все, мы успешно перенесли код веб-камеры с VB6 на VBA и воссоздали форму, которая редко описывалась в предоставленной вами ссылке. По большей части кода авторы переходят по этой ссылке.
Вы можете временно загрузить результат здесь . Обратите внимание, что я рекомендую этого не делать, как в образовательных целях, так и потому, что вам не следует доверять случайным незнакомцам в Интернете, дающим вам неподписанные исполняемые файлы. Но это полезно, если вы столкнулись с ошибкой, поэтому вы можете проверить, может ли это быть проблема совместимости веб-камеры или ошибка.
Обратите внимание, что я не внес никаких реальных функциональных изменений в исходный код.