关于像头取像及查询问题，盼望解答
输入姓名，用摄像头取像，保存在数据库中access，我想实现能在摄像头捕捉到的画面上可以画一个矩形的透明虚线框，如果鼠标在矩形框中按下鼠标左键时候，能拖动这个虚线的矩形框来移动它。双击的时候就可以截取虚线框选中的照片了（即照片上的部分图片截取），然后在打开界面时，输入不同姓名，自动显示不同照片，盼望解决，谢谢.

使用 ezVidC60.ocx 控件
QQ  318352920 可以交流

[[it] 本帖最后由 taihongbo 于 2008-5-19 13:29 编辑 [/it]]

Option Explicit
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Dim Pnt As POINTAPI
Dim PntSharp As POINTAPI

Dim CurX As Long
Dim CurY As Long
Dim DistX As Long
Dim DistY As Long
Dim nOldX As Long
Dim nOldy As Long

Const mDist = 150 '150 twips
Private Sub Command1_Click()
    On Error Resume Next
    '-----------------------------------
    Me.Shape1.BorderStyle = 0
    DoEvents
    Picture3.Cls
    Picture3.AutoRedraw = True
    Picture3.PaintPicture Image1.Picture, 0, 0, Picture3.Width, Picture3.Height, Me.Shape1.Left, Me.Shape1.Top, Me.Shape1.Width, Me.Shape1.Height, vbSrcCopy
    Picture3.AutoRedraw = True
    Picture3.Refresh
    DoEvents
    Me.Shape1.BorderStyle = 3
    DoEvents
    '--------------------------------------
    SavePicture Picture3.Image, "C:\Temp.Bmp"
    DoEvents
    '--------------------------------------
    Call SaveSetting("www., "慢性病", "Top", Me.Shape1.Top)
    Call SaveSetting("www., "慢性病", "Left", Me.Shape1.Left)
    Call SaveSetting("www., "慢性病", "Width", Me.Shape1.Width)
    Call SaveSetting("www., "慢性病", "Height", Me.Shape1.Height)
    Unload Me
    '-----------------------------------
End Sub

Private Sub Form_Load()
    Dim nTop As Long
    Dim nLeft As Long
    Dim nWidth As Long
    Dim nHeight As Long
    '--------------------------------使用前一次纪录的位置
    nTop = Val(GetSetting("www., "慢性病", "Top", ""))
    nLeft = Val(GetSetting("www., "慢性病", "Left", ""))
    nWidth = Val(GetSetting("www., "慢性病", "Width", ""))
    nHeight = Val(GetSetting("www., "慢性病", "Height", ""))
    If nTop <> 0 And nLeft <> 0 And nWidth <> 0 And nHeight <> 0 Then
        Me.Shape1.Top = nTop
        Me.Shape1.Left = nLeft
        Me.Shape1.Width = nWidth
        Me.Shape1.Height = nHeight
    End If
   
    ezVidCap1.Top = 0
    ezVidCap1.Left = 0
   
    Me.Width = Me.ezVidCap1.Width
    Me.Height = Me.ezVidCap1.Height
   
    Call SetCommand
End Sub
Private Sub Form_Resize()
    Me.Picture2.Top = 15
    Me.Picture2.Left = 15
    Me.Picture2.Width = Me.ScaleWidth - 30
    Me.Picture2.Height = Me.ScaleHeight - 30
    Image1.Top = 0
    Image1.Left = 0
    Image1.Height = Me.Picture2.Height
    Image1.Width = Me.Picture2.Width
   
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    GetCursorPos Pnt    'Get mouse position
    ScreenToClient Me.hwnd, Pnt    'Convert to client coordinate
    CurX = Pnt.X * Screen.TwipsPerPixelX    'Pixels to Twips
    CurY = Pnt.Y * Screen.TwipsPerPixelY
    DistX = Abs(CurX - (Shape1.Left + Shape1.Width))    'distance to Shape1's
    DistY = Abs(CurY - (Shape1.Top + Shape1.Height))
   
    If DistX <= mDist And DistY <= mDist Then    'set mouse pointer   'according to distance
        Me.MousePointer = vbSizeNWSE
    ElseIf DistX <= mDist And DistY > mDist Then
        Me.MousePointer = vbSizeWE
    ElseIf DistX > mDist And DistY <= mDist Then
        Me.MousePointer = vbSizeNS
    Else
        Me.MousePointer = vbDefault
    End If
    If Button = 1 Then
        If Me.MousePointer = vbSizeNWSE Then
            Shape1.Width = CurX - Shape1.Left
            Shape1.Height = CurY - Shape1.Top
        End If
        If Me.MousePointer = vbSizeWE Then
            Shape1.Width = CurX - Shape1.Left
        End If
        If Me.MousePointer = vbSizeNS Then
            Shape1.Height = CurY - Shape1.Top
        End If
        If Me.MousePointer = vbDefault Then
            Me.Shape1.Top = CurY + nOldy
            Me.Shape1.Left = CurX + nOldX
        End If
        Call SetCommand
        
    End If
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        GetCursorPos Pnt                        'Get mouse position
        ScreenToClient Me.hwnd, Pnt             'Convert to client coordinate
        CurX = Pnt.X * Screen.TwipsPerPixelX    'Pixels to Twips
        CurY = Pnt.Y * Screen.TwipsPerPixelY
        nOldX = Me.Shape1.Left - CurX
        nOldy = Me.Shape1.Top - CurY
        Call SetCommand
        Me.Timer1.Interval = 0
    End If

End Sub

Sub SetCommand()
    Err.Clear
    = Me.Shape1.Top + Me.Shape1.Height + 200
    = Me.Shape1.Left
    = Me.Shape1.Width
      
   
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Me.Timer1.Interval = 100
    End If
   
End Sub

Private Sub Timer1_Timer()
    Me.ezVidCap1.EditCopy
    Me.Picture1.Picture = Clipboard.GetData()   ' 从剪贴板上复制。
    Me.Image1.Picture = Me.Picture1.Picture

End Sub

'--------------------QQ  318352920 可以交流

[[it] 本帖最后由 taihongbo 于 2008-5-19 13:29 编辑 [/it]]

虽不是想像中的，但有借鉴，谢谢继续支持.