A. VB程序源码如何使用
需要安装vb6.0开发软件
如果安装了，就可以直接打开源码测试了，后缀名是vbp，（就是vb的工程文件）
如果没有安装vb6.0，还想打开源码看程序，那就右击 用记事本 打开后缀名为frm的文件，他是vb的窗口文件，源码都在他里面
一般得源码是没有生成exe可执行文件的，那样文件太多，太大，浪费空间
如果你自己想生成exe可执行文件，那就vb6.0得文件菜单中把文件保存成exe可执行文件就可以了，
B. 濡备綍瑙ｅ喅涓嬭浇镄勪竴涓猇B6.0钥佹彁绀衡滆繍琛屽畨瑁呯▼搴忓墠锛屽繀椤婚栧厛杩愯屽畨瑁呭悜瀵尖濓纻
绋嫔簭 -> 寮濮 -> 杩愯 -> 杈揿叆 regedit 铹跺悗锲炶溅銆
鍒犻櫎HKEY_LOCAL_涓嬮溃镄勬墍链変俊鎭銆傛妸VisualStudio杩欎釜鏂囦欢澶逛篃涓璧峰垹銆
铹跺悗鍐嶈繍琛宻etup.exe銆
C. vb6 无驱摄像头编程 求源码
发下是我几年前写的(参照)一个VB驱动摄像头的代码,不知道现在还能不能用,因为文件总的很长,这只是其中的一小部分,希望对你有所用.(要不就和我联系,给你源码)
Private Sub Form_Load()
On Error Resume Next
Dim retVal As Boolean
Dim numDevs As Long
bCaramaPlaying = True
'load trivial settings first
Me.BackColor = Val(GetSetting(App.Title, "preferences", "backcolor", "&H404040")) 'default to dk gray
numDevs = VBEnumCapDrivers(Me)
If 0 = numDevs Then
MsgBox "没有找到视频捕捉设备!", vbCritical, App.Title
' frmPlayer.Visible = True
' If bIsVisible = True And vbPlayFormIsVisible = True And vbFrmPlayFrameHided = False Then
' frmPlayFrame.Visible = True
' End If
Unload Me
Exit Sub
End If
nDriverIndex = Val(GetSetting(App.Title, "driver", "index", "0"))
'if invalid entry is in registry use default (0)
If mnuDriver.UBound < nDriverIndex Then
nDriverIndex = 0
End If
mnuDriver(nDriverIndex).Checked = True
'//Create Capture Window
'Call capGetDriverDescription( nDriverIndex, lpszName, 100, lpszVer, 100 '// Retrieves driver info
hCapWnd = capCreateCaptureWindow("VB CAP WINDOW", WS_CHILD Or WS_VISIBLE, 0, 0, 160, 120, Me.hWnd, 0)
If 0 = hCapWnd Then
MsgBox "不能创建捕捉窗口!", vbCritical, App.Title
Exit Sub
End If
retVal = ConnectCapDriver(hCapWnd, nDriverIndex)
If False = retVal Then
MsgBox "不能连接到视频设备!", vbInformation, App.Title
Else
#If USECALLBACKS = 1 Then
' if we have a valid capwnd we can enable our status callback function
Call capSetCallbackOnStatus(hCapWnd, AddressOf StatusProc)
Debug.Print "---Callback set on capture status---"
#End If
End If
'// Set the video stream callback function
' capSetCallbackOnVideoStream lwndC, AddressOf MyVideoStreamCallback
' capSetCallbackOnFrame lwndC, AddressOf MyFrameCallback
Dim bPlayFrameTop As Boolean
bPlayFrameTop = GetSetting(MyName, "setting" & "-" & Trim(Str(App.Major)) & "-" & Trim(Str(App.Minor)), "bPlayFrameTop", "False")
If bPlayFrameTop = True Then
Me.mnuOptionTop.Checked = True
'放在最前
SetWindowPos Me.hWnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, &H20
Else
Me.mnuOptionTop.Checked = False
'不放在最前
SetWindowPos Me.hWnd, HWND_NOTOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, &H20
End If
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
Me.picShowMenu.ZOrder 0
End Sub
'以下是一个模块文件
Option Explicit
'application specific routines are here
Public Const ONE_MEGABYTE As Long = 1048576
'Public Const MMSYSERR_NOERROR As Long = 0
Public Const INDEX_15_MINUTES As Long = 27000 '(30fps * 60sec * 15min)
Public Const INDEX_3_HOURS As Long = 324000 ' (30fps * 60sec * 60min * 3hr)
Public Function GetFreeSpace() As Long
'this function gets the amount of free disk space and adds the size
'of the current capture file
Dim freedisk As Long
Dim path As String
'get Cap File length
path = capFileGetCaptureFile(frmCaramaMain.capwnd)
If path <> "" Then
On Error Resume Next
freedisk = FileLen(path)
freedisk = freedisk / ONE_MEGABYTE
End If
'now get free disk space from that drive
path = Left$(path, 3)
GetFreeSpace = freedisk + vbGetAvailableMBytes(path)
End Function
Sub ResizeCaptureWindow(ByVal hCapWnd As Long)
Dim retVal As Boolean
Dim capStat As CAPSTATUS
'Get the capture window attributes
retVal = capGetStatus(hCapWnd, capStat)
If retVal Then
'Resize the main form to fit
Call SetWindowPos(frmCaramaMain.hWnd, _
0&, _
0&, _
0&, _
capStat.uiImageWidth + (frmCaramaMain.XBorder * 2), _
capStat.uiImageHeight + (frmCaramaMain.YBorder * 4) _
+ frmCaramaMain.CaptionHeight + frmCaramaMain.MenuHeight, _
Swp_nomove Or SWP_NOZORDER Or SWP_NOSENDCHANGING)
'Resize the capture window to format size
Call SetWindowPos(hCapWnd, _
0&, _
0&, _
0&, _
capStat.uiImageWidth, _
capStat.uiImageHeight, _
Swp_nomove Or SWP_NOZORDER Or SWP_NOSENDCHANGING)
End If
Call frmCaramaMain.Form_Resize
End Sub
Public Function VBEnumCapDrivers(ByRef frm As frmCaramaMain) As Long
'/*
' * Enumerate the potential capture drivers and add the list to the Options
' * menu. This function is only called once at startup.
' * Returns 0 if no drivers are available.
' */
Const MAXVIDDRIVERS As Long = 9
Const CAP_STRING_MAX As Long = 128
Dim numDrivers As Long
Dim driverStrings(0 To MAXVIDDRIVERS - 1) As String
Dim Index As Long
Dim Device As String
Dim Version As String
Dim menu As VB.menu
Device = String$(CAP_STRING_MAX, 0)
Version = String$(CAP_STRING_MAX, 0)
numDrivers = 0
For Index = 0 To (MAXVIDDRIVERS - 1) Step 1
If 0 <> capGetDriverDescription(Index, _
Device, _
CAP_STRING_MAX, _
Version, _
CAP_STRING_MAX) _
Then
'extend the menu
If Index > 0 Then
Load frm.mnuDriver(Index)
End If
Set menu = frm.mnuDriver(Index) 'get an object pointer to the new menu
'Concatenate the device name and version strings to the new menu item
menu.Caption = Left$(Device, InStr(Device, vbNullChar) - 1)
menu.Caption = menu.Caption & " "
menu.Caption = menu.Caption & Left$(Version, InStr(Version, vbNullChar) - 1)
menu.Enabled = True
numDrivers = numDrivers + 1
End If
Next
VBEnumCapDrivers = numDrivers
End Function
Public Function ConnectCapDriver(ByVal hCapWnd As Long, ByVal nDriverIndex As Long) As Boolean
Dim retVal As Boolean
Dim Caps As CAPDRIVERCAPS
Dim i As Long
Debug.Assert (nDriverIndex < 10) And (nDriverIndex >= 0)
'// Connect the capture window to the driver
retVal = capDriverConnect(hCapWnd, nDriverIndex)
If False = retVal Then
'return False
Exit Function
End If
'// Get the capabilities of the capture driver
retVal = capDriverGetCaps(hCapWnd, Caps)
If False <> retVal Then
'reset menus (very app-specific)
With frmCaramaMain
For i = 0 To .mnuDriver.UBound
.mnuDriver(i).Checked = False 'make sure all drivers are unchecked
Next
.mnuDriver(nDriverIndex).Checked = True 'then check the new driver
'disable all hardware feature menu items
.mnuSource.Enabled = False
.mnuFormat.Enabled = False
.mnuDisplay.Enabled = False
.mnuOverlay.Enabled = False
'Then enable the ones which are supported by the new driver
If Caps.fHasDlgVideoSource <> 0 Then .mnuSource.Enabled = True
If Caps.fHasDlgVideoFormat <> 0 Then .mnuFormat.Enabled = True
If Caps.fHasDlgVideoDisplay <> 0 Then .mnuDisplay.Enabled = True
If Caps.fHasOverlay <> 0 Then .mnuOverlay.Enabled = True
End With
End If
'// Set the preview rate in milliseconds
Call capPreviewRate(hCapWnd, 66) '15 FPS
'// Start previewing the image from the camera
Call capPreview(hCapWnd, True)
'default to showing a preview each time
frmCaramaMain.mnuPreview.Checked = True
'// Resize the capture window to show the whole image
Call ResizeCaptureWindow(hCapWnd)
ConnectCapDriver = True
End Function
Public Function StatusProc(ByVal hCapWnd As Long, ByVal StatusCode As Long, ByVal lpStatusString As Long) As Long
Select Case StatusCode
Case 0 'this is recommended in docs
'when zero is sent, clear old status messages
'frmCaramaMain.Caption = App.Title
Case IDS_CAP_END ' Video Capture has finished
frmCaramaMain.Caption = App.Title
Case IDS_CAP_STAT_VIDEOAUDIO, IDS_CAP_STAT_VIDEOONLY
MsgBox LPSTRtoVBString(lpStatusString), vbInformation, App.Title
Case Else
'use this function if you need a real VB string
'frmCaramaMain.Caption = LPSTRtoVBString(lpStatusString)
'or, just pass the LPCSTR to a WINAPI function
Call SetWindowTextAsLong(frmCaramaMain.hWnd, lpStatusString)
End Select
Debug.Print "Driver returned code " & StatusCode & " to StatusProc"
StatusProc = -(True) '- converts Boolean to C BOOL
End Function