Const BlockSize = 100000
Dim NumBlocks As Integer
Dim FileLength As Long
Dim LeftOver As Long
Dim i As Integer
Dim n As Integer
Dim ByteData() As Byte
Dim Filename1 As String
Dim FileNum As Integer
Dim DiskFile As String

Private Sub Comm1_Click()
If Trim(Text1(1).Text) = "" Then
MsgBox "加*数据项不能为空，请重新设置", vbOKOnly, "信息提示"
Text1(1).SetFocus
Exit Sub
End If
If Trim(Text1(0).Text) = "" Then
MsgBox "加*数据项不能为空，请重新设置", vbOKOnly, "信息提示"
Text1(0).SetFocus
Exit Sub
End If
If Trim(Text1(2).Text) <> "" Then
  If Not IsDate(Trim(Text1(2).Text)) Then
  MsgBox "出生日期输入格式不正确，重新输入", vbOKOnly, "信息提示"
  Text1(2).SetFocus
  Exit Sub
  End If
  End If
  If flag = 1 Then
  recs = recs + 1
  edks.Adodc1.Recordset.AddNew
  End If
  edks.Adodc1.Recordset.Fields("报名号") = Trim(Text1(0).Text)
  
    edks.Adodc1.Recordset.Fields("姓名") = Trim(Text1(1).Text)
    If Opt1.Value = True Then
      edks.Adodc1.Recordset.Fields("性别") = "男"
    ElseIf Opt2.Value = True Then
      edks.Adodc1.Recordset.Fields("性别") = "女"
      Else
        edks.Adodc1.Recordset.Fields("性别") = ""
    End If
        If Trim(Text1(2).Text) <> "" Then
          edks.Adodc1.Recordset.Fields("出生日期") = Format(Trim(Text1(2).Text), "yyyy-mm-dd")
          End If
            edks.Adodc1.Recordset.Fields("通信地址") = Trim(Text1(3).Text)
        edks.Adodc1.Recordset.Fields("邮政编码") = Trim(Text1(4).Text)
      edks.Adodc1.Recordset.Fields("合格否") = False
  
  
    edks.Adodc1.Recordset.Fields("数学") = 0
    
    edks.Adodc1.Recordset.Fields("外语") = 0
    
    edks.Adodc1.Recordset.Fields("政治") = 0
    
    edks.Adodc1.Recordset.Fields("专业课") = 0
    
    edks.Adodc1.Recordset.Fields("总分") = 0
    Filename1 = Trim(CommonDialog1.Filename)
    If sel = True Then
    Image1.Picture = LoadPicture(CommonDialog1.Filename)
    Me.MousePointer = vbHourglass
    FileNum = FreeFile()
    Open Filename1 For Binary Access Read As FileNum
    FileLength = LOF(FileNum)
    
    If FileLength = 0 Then
    Close FileNum
    MsgBox "指定的图像文件不存在", 0, "信息提示"
    Else
    NumBlocks = FileLength \ BlockSize
    LeftOver = FileLength Mod BlockSize
    ReDim ByteData(LeftOver)
    Get FileNum, , ByteData()
    edks.Adodc1.Recordset("照片").AppendChunk ByteData()
    ReDim ByteData(BlockSize)
    For i = 1 To NumBlocks
    Get FileNum, , ByteData()
     edks.Adodc1.Recordset("照片").AppendChunk ByteData()
     Next i
     edks.Adodc1.Recordset("照片长度") = FileLength
     End If
     Close FileNum
     Me.MousePointer = vbNormal
     End If
     edks.Adodc1.Recordset.Update
     Unload Me
     
     
     
    
    
  
  
  
  

End Sub

Private Sub comm2_Click()
Unload Me

End Sub



Private Sub Form_Load()
sel = False
DiskFile = App.Path & "\图片\电脑.bmp"
If flag = 2 Then
Text1(0).Text = Trim(edks.Adodc1.Recordset.Fields("报名号"))

Text1(1).Text = Trim(edks.Adodc1.Recordset.Fields("姓名")) & ""
If edks.Adodc1.Recordset.Fields("性别") = "男" Then
Opt1.Value = True
ElseIf edks.Adodc1.Recordset.Fields("性别") = "女" Then
Opt2.Value = True
End If


Text1(2).Text = Trim(edks.Adodc1.Recordset.Fields("出生日期")) & ""


Text1(3).Text = Trim(edks.Adodc1.Recordset.Fields("通信地址")) & ""


Text1(4).Text = Trim(edks.Adodc1.Recordset.Fields("邮政编码")) & ""


Text1(5).Text = Trim(edks.Adodc1.Recordset.Fields("准考证号")) & ""
If edks.Adodc1.Recordset.Fields("照片长度") > 0 Then
Me.MousePointer = vbHourglass
FileLength = edks.Adodc1.Recordset("照片长度")
If FileLength > 10000 Then
n = 5
Else
n = 10
End If
If Len(Dir$(DiskFile)) > 0 Then
Kill DiskFile
End If
FileNum = FreeFile()
Open DiskFile For Binary Access Write As FileNum
NumBlocks = FileLength \ (BlockSize \ n)
LeftOver = FileLength Mod (BlockSize \ n)
ReDim ByteData(BlockSzie \ n)
For i = 1 To NumBlocks
ByteData() = edks.Adodc1.Recordset("照片").GetChunk(BlockSize \ n)
Put FileNum, , ByteData
Next i
If LeftOver > 0 Then
ReDim ByteData(LeftOver)
ByteData() = edks.Adodc1.Recordset("照片").GetChunk(LeftOver)
Put FileNum, , ByteData
End If
Close FileNum
Image1.Picture = LoadPicture(DiskFile)
Me.MousePointer = vbNormal
Else
Image1.Picture = LoadPicture()
End If
Else
Image1.Picture = LoadPicture()
Num = Num + 1
Text1(0).Text = Trim(Str(Num))
End If








End Sub

Private Sub Form_Unload(Cancel As Integer)
Text1(5).Enabled = True

End Sub

Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub selcom_Click()
With CommonDialog1
.Filter = "pictures(*.bmp;*.jpg|*.bmp;*.jpg)"
.ShowOpen
End With
If CommonDialog1.Filename <> "" Then
Image1.Picture = LoadPicture(CommonDialog1.Filename)
sel = True
End If

End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
Call endata(KeyAscii)

End Sub
请问高手能否给我改一下，能让图片用摄像头获取且能保存？谢谢。。。