www.pudn.com > 图像采集-vb.rar > Form1.frm


VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 8205
ClientLeft = 60
ClientTop = 345
ClientWidth = 6615
LinkTopic = "Form1"
ScaleHeight = 8205
ScaleWidth = 6615
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command9
Caption = "图像格式"
Height = 375
Left = 120
TabIndex = 25
Top = 2040
Width = 1335
End
Begin VB.CommandButton Command5
Caption = "清空拍照"
Height = 375
Left = 120
TabIndex = 8
Top = 3960
Width = 1335
End
Begin VB.CommandButton Command8
Caption = "拍照"
Height = 375
Left = 120
TabIndex = 7
Top = 3600
Width = 1335
End
Begin VB.CommandButton Command7
Caption = "暂停图像"
Height = 375
Left = 120
TabIndex = 6
Top = 3000
Width = 1335
End
Begin VB.CommandButton Command6
Caption = "播放图像"
Height = 375
Left = 120
TabIndex = 5
Top = 2640
Width = 1335
End
Begin VB.CommandButton Command4
Caption = "缩小图像"
Height = 375
Left = 120
TabIndex = 4
Top = 1080
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "放大图像"
Height = 375
Left = 120
TabIndex = 3
Top = 720
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "显示预览"
Height = 375
Left = 120
TabIndex = 2
Top = 120
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 375
Left = 120
TabIndex = 1
Top = 4560
Width = 1335
End
Begin VB.CommandButton Command10
Caption = "图像控制"
Height = 375
Left = 120
TabIndex = 26
Top = 1680
Width = 1335
End
Begin VB.PictureBox PIC_show
Height = 4095
Left = 1680
ScaleHeight = 4035
ScaleWidth = 4755
TabIndex = 0
Top = 120
Width = 4815
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 15
Left = 0
TabIndex = 24
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 14
Left = 0
TabIndex = 23
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 13
Left = 0
TabIndex = 22
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 12
Left = 0
TabIndex = 21
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 11
Left = 0
TabIndex = 20
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 10
Left = 0
TabIndex = 19
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 9
Left = 0
TabIndex = 18
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 8
Left = 0
TabIndex = 17
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 7
Left = 0
TabIndex = 16
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 6
Left = 0
TabIndex = 15
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 5
Left = 0
TabIndex = 14
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 4
Left = 0
TabIndex = 13
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 3
Left = 0
TabIndex = 12
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 2
Left = 0
TabIndex = 11
Top = 0
Width = 495
End
Begin VB.Label Label1
Caption = "Label1"
Height = 255
Index = 1
Left = 360
TabIndex = 10
Top = 5880
Width = 495
End
Begin VB.Label Label1
BackColor = &amt;H0000FFFF&amt;
Caption = "Label1"
Height = 180
Index = 0
Left = 360
TabIndex = 9
Top = 6120
Width = 540
End
Begin VB.Image Image1
Height = 735
Index = 15
Left = 5280
Top = 7080
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 14
Left = 4080
Top = 7080
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 13
Left = 2880
Top = 7080
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 12
Left = 1680
Top = 7080
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 11
Left = 5280
Top = 6240
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 10
Left = 4080
Top = 6240
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 9
Left = 2880
Top = 6240
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 8
Left = 1680
Top = 6240
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 7
Left = 5280
Top = 5280
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 6
Left = 4080
Top = 5280
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 5
Left = 2880
Top = 5280
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 4
Left = 1680
Top = 5280
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 3
Left = 5280
Top = 4440
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 2
Left = 4080
Top = 4440
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 1
Left = 2880
Top = 4440
Width = 855
End
Begin VB.Image Image1
Height = 735
Index = 0
Left = 1680
Top = 4440
Width = 855
End
Begin VB.Image Picture1
Height = 735
Left = 2520
Stretch = -1 'True
Top = 3840
Width = 255
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Ret As Integer
Dim iii As Integer
Private Const SWP_NOZORDER = &amt;H4
Private Sub Command1_Click()
Dim x1, y1, w, h As Integer
x1 = 0 'Int(PIC_show.Left / Screen.TwipsPerPixelX)
y1 = 0 'Int(PIC_show.Top / Screen.TwipsPerPixelY)
w = 320 'Int(PIC_show.Width / Screen.TwipsPerPixelX)
h = 240 'Int(PIC_show.Height / Screen.TwipsPerPixelY)
'hCapture = capCreateCaptureWindow("vb-采集图像", WS_CHILD Or WS_VISIBLE, x1, y1, w, h, PIC_show.hwnd, 0)
hCapture = capCreateCaptureWindow("vb-采集图像", WS_CHILD Or WS_VISIBLE, 0, 0, 320, 240, PIC_show.hwnd, 0)

'Make sure you are connecting to the right driver index!
Ret = SendMessage(hCapture, WM_CAP_DRIVER_CONNECT, 0, 0)
Ret = SendMessage(hCapture, WM_CAP_SET_PREVIEW, 1, 0)
Ret = SendMessage(hCapture, WM_CAP_SET_SCALE, 1, 0)
Ret = SendMessage(hCapture, WM_CAP_SET_PREVIEWRATE, 66, 0)

' Ret = SendMessageU(hCapture, WM_CAP_GET_SEQUENCE_SETUP, Len(udtCaptureParms), udtCaptureParms)

'udtCaptureParms.dwRequestMicroSecPerFrame = 1000000 / 15
'udtCaptureParms.fCaptureAudio = 0
'udtCaptureParms.fLimitEnabled = 1
' udtCaptureParms.wTimeLimit = 5

' Ret = SendMessageU(hCapture, WM_CAP_SET_SEQUENCE_SETUP, Len(udtCaptureParms), udtCaptureParms)

End Sub

Private Sub Command10_Click()
Dim Ret As Integer
Ret = SendMessage(hCapture, WM_CAP_DLG_VIDEOSOURCE, 0, 0)
End Sub

Private Sub Command2_Click()
Ret = SendMessage(hCapture, WM_CAP_ABORT, 0, 0) 'capCaptureAbort(m_hCapture);//停止捕获
Ret = SendMessage(hCapture, WM_CAP_SET_CALLBACK_STATUS, 0, 0) 'capSetCallbackOnStatus(m_hCapture, NULL);
Ret = SendMessage(hCapture, WM_CAP_SET_CALLBACK_ERROR, 0, 0) 'capSetCallbackOnError(m_hCapture, NULL);
Ret = SendMessage(hCapture, WM_CAP_SET_CALLBACK_FRAME, 1, 0) ' capSetCallbackOnFrame(m_hCapture, NULL);
Ret = SendMessage(hCapture, WM_CAP_DRIVER_DISCONNECT, 0, 0) 'capDriverDisconnect(m_hCapture);
Unload Me
End Sub

Private Sub Command3_Click()
Dim Ret As Integer
Ret = SetWindowPos(hCapture, 0, 0, 0, 320, 240, SWP_NOZORDER)
End Sub

Private Sub Command4_Click()
Dim Ret As Integer
Ret = SetWindowPos(hCapture, 0, 0, 0, 160, 120, SWP_NOZORDER)
End Sub

Private Sub Command5_Click()
Dim i As Integer
For i = 0 To 15 Step 1

Label1(i).Caption = Trim(Format(i, "000"))
Label1(i).Visible = False

Image1(i).Picture = LoadPicture("")

Next i
iii = 0
End Sub

Private Sub Command6_Click()

Ret = SendMessage(hCapture, WM_CAP_SET_PREVIEW, 1, 0)
Ret = SendMessage(hCapture, WM_CAP_SET_OVERLAY, 0, 0)

End Sub

Private Sub Command7_Click()

Ret = SendMessage(hCapture, WM_CAP_SET_PREVIEW, 0, 0)
Ret = SendMessage(hCapture, WM_CAP_SET_OVERLAY, 0, 0)

End Sub

Private Sub Command8_Click()
Dim FileStr As String
iii = iii + 1
If (iii Mod 16 = 1) Then
ClearCurPic
End If


FileStr = "d:\temp\test\"
FileStr = FileStr + Trim(Format(iii, "000")) + ".dib"
'fResult = capGrabFrameNoStop(m_hCapture) ;
' capGetStatus(m_hCapture, &amt;gCapStatus, sizeof(CAPSTATUS)) ;
' capOverlay(m_hCapture, !gCapStatus.fOverlayWindow) ;
' capPreview(m_hCapture, !gCapStatus.fLiveWindow) ;
' capFileSaveDIB(m_hCapture,FileName);
Ret = SendMessage(hCapture, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0)
Ret = SendMessageS(hCapture, WM_CAP_FILE_SAVEDIB, 0, FileStr)


Image1(((iii - 1) Mod 16)).Picture = LoadPicture(FileStr)
Label1(((iii - 1) Mod 16)).Caption = Trim(Format(iii, "000"))
Label1(((iii - 1) Mod 16)).Visible = True

End Sub

Private Sub Command9_Click()
Dim Ret As Integer
Ret = SendMessage(hCapture, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
End Sub

Private Sub Form_Load()
Dim i As Integer
iii = 0
PIC_show.Width = 320 * Screen.TwipsPerPixelX
PIC_show.Height = 240 * Screen.TwipsPerPixelY
For i = 0 To 15 Step 1
Label1(i).BackStyle = 1
Label1(i).BackColor = &amt;HFF&amt;
Label1(i).ForeColor = &amt;HFFFF&amt;
Label1(i).Caption = Trim(Format(i, "000"))
Label1(i).AutoSize = True
Label1(i).Visible = False

Image1(i).BorderStyle = 1
Image1(i).Stretch = True

Label1(i).Left = Image1(i).Left
Label1(i).Top = Image1(i).Top
Next i
Picture1.Visible = False
Picture1.Left = PIC_show.Left
Picture1.Top = PIC_show.Top
Picture1.Width = PIC_show.Width
Picture1.Height = PIC_show.Height
End Sub

Private Sub ClearCurPic()
Dim i As Integer
For i = 0 To 15 Step 1

Label1(i).Caption = Trim(Format(i, "000"))
Label1(i).Visible = False

Image1(i).Picture = LoadPicture("")

Next i
End Sub

Private Sub Image1_Click(Index As Integer)
If (Label1(Index).Visible = True) Then
PIC_show.Visible = False
Picture1.Visible = True
Picture1.Picture = LoadPicture("d:\temp\test\" + Trim(Label1(Index).Caption) + ".dib")
End If
End Sub

Private Sub Picture1_Click()
If (Picture1.Visible = True) Then
PIC_show.Visible = True
Picture1.Visible = False
End If
End Sub