camcap.frm

Control ocx de una cam de la leche pedrin

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Capturador"
   ClientHeight    =   7005
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8100
   Icon            =   "Camcap.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   7005
   ScaleWidth      =   8100
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer cap 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   0
      Top             =   840
   End
   Begin VB.CommandButton Command7 
      Caption         =   "Parar la c醡ara"
      Enabled         =   0   'False
      Height          =   255
      Left            =   0
      TabIndex        =   25
      Top             =   6600
      Width           =   1575
   End
   Begin VB.CommandButton Command6 
      Caption         =   "Iniciar la c醡ara"
      Height          =   255
      Left            =   0
      TabIndex        =   24
      Top             =   6240
      Width           =   1575
   End
   Begin VB.CommandButton Command9 
      Caption         =   "Ayuda"
      Height          =   315
      Left            =   1680
      TabIndex        =   23
      Top             =   6600
      Width           =   2535
   End
   Begin VB.CommandButton Command5 
      Caption         =   "Ver Captura"
      Height          =   255
      Left            =   3120
      TabIndex        =   13
      Top             =   6360
      Width           =   1095
   End
   Begin VB.CommandButton Command8 
      Caption         =   "Convertir Captura"
      Height          =   495
      Left            =   3120
      TabIndex        =   20
      Top             =   5880
      Width           =   1095
   End
   Begin VB.CheckBox chkProg 
      Caption         =   "Progressive"
      Height          =   195
      Left            =   6720
      TabIndex        =   19
      Top             =   6600
      Value           =   1  'Checked
      Width           =   1215
   End
   Begin VB.Frame Frame2 
      Caption         =   "Grabar en:"
      Height          =   1335
      Left            =   4440
      TabIndex        =   14
      Top             =   5640
      Width           =   3615
      Begin VB.HScrollBar hshQual 
         Height          =   255
         Left            =   120
         Max             =   100
         TabIndex        =   17
         Top             =   960
         Value           =   100
         Width           =   2055
      End
      Begin VB.OptionButton Option5 
         Caption         =   "JPG"
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   480
         Value           =   -1  'True
         Width           =   615
      End
      Begin VB.OptionButton Option4 
         Caption         =   "BMP"
         Height          =   255
         Left            =   120
         TabIndex        =   15
         Top             =   240
         Width           =   735
      End
      Begin VB.Label Label8 
         Caption         =   "Captura m醩 lento"
         Height          =   255
         Left            =   840
         TabIndex        =   22
         Top             =   480
         Width           =   1335
      End
      Begin VB.Label Label7 
         Caption         =   "Captura m醩 r醦ido"
         Height          =   195
         Left            =   840
         TabIndex        =   21
         Top             =   240
         Width           =   1365
      End
      Begin VB.Label Label6 
         Caption         =   "Calidad de jpg:"
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   720
         Width           =   1815
      End
   End
   Begin VB.TextBox Text4 
      Height          =   285
      Left            =   4440
      TabIndex        =   11
      Top             =   5280
      Width           =   3615
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Resetear"
      Height          =   255
      Left            =   1680
      TabIndex        =   10
      Top             =   6360
      Width           =   1455
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Detener Captura"
      Height          =   255
      Left            =   1680
      TabIndex        =   9
      Top             =   6120
      Width           =   1455
   End
   Begin VB.TextBox Text3 
      Height          =   285
      Left            =   1680
      TabIndex        =   7
      Text            =   "10"
      Top             =   5280
      Width           =   2535
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   0
      TabIndex        =   5
      Text            =   "0"
      Top             =   5880
      Width           =   1575
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Left            =   0
      Top             =   360
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   0
      Top             =   0
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Empezar captura"
      Height          =   255
      Left            =   1680
      TabIndex        =   3
      Top             =   5880
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Grabar en..."
      Height          =   255
      Left            =   1680
      TabIndex        =   2
      Top             =   5640
      Width           =   2535
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   0
      TabIndex        =   1
      Text            =   "1"
      Top             =   5280
      Width           =   1575
   End
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      Height          =   4935
      Left            =   0
      ScaleHeight     =   4875
      ScaleWidth      =   7875
      TabIndex        =   0
      Top             =   0
      Width           =   7935
   End
   Begin VB.Label Label4 
      Caption         =   "Grabando en:"
      Height          =   255
      Left            =   4440
      TabIndex        =   12
      Top             =   5040
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "Capturar cada: (Cent閏imas de segundo)"
      Height          =   255
      Left            =   1440
      TabIndex        =   8
      Top             =   5040
      Width           =   3015
   End
   Begin VB.Label Label2 
      Caption         =   "Parar captura en..."
      Height          =   255
      Left            =   0
      TabIndex        =   6
      Top             =   5640
      Width           =   1575
   End
   Begin VB.Label Label1 
      Caption         =   "Empezar en:"
      Height          =   255
      Left            =   0
      TabIndex        =   4
      Top             =   5040
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public filevar, filepath
Private Declare Function DIWriteJpg Lib "DIjpg.dll" (ByVal DestPath As String, ByVal quality As Long, ByVal progressive As Long) As Long

Private Sub camcap_Timer()
On Error Resume Next
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
Clipboard.Clear
End Sub

Private Sub cap_Timer()
On Error Resume Next
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
Clipboard.Clear
End Sub

Private Sub Command1_Click()
Form3.Show
End Sub

Private Sub Command2_Click()
On Error Resume Next
Timer2.Interval = Val(Text3.Text) * 10
Timer1.Enabled = True
Picture1.Height = 12520
Picture1.Width = 22520
If Command6.Enabled = True Then
Command6_Click
End If
End Sub

Private Sub Command3_Click()
Timer1.Enabled = False
Timer2.Enabled = False
Picture1.Height = 4935
Picture1.Width = 7935
Command7_Click
End Sub

Private Sub Command4_Click()
Timer1.Enabled = False
Timer2.Enabled = False
filevar = ""
filepath = ""
Text1.Text = 0
Text2.Text = 0
Text3.Text = 10
Text4.Text = ""
Picture1.Height = 4935
Picture1.Width = 7935
End Sub

Private Sub Command5_Click()
Form2.Show
End Sub

Private Sub Command6_Click()
Command6.Enabled = False
Command7.Enabled = True
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hWnd, 0)
DoEvents: SendMessage mCapHwnd, CONNECT, 0, 0
cap.Enabled = True
End Sub


Private Sub Command7_Click()
Command6.Enabled = True
Command7.Enabled = False
cap.Enabled = False
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
End Sub

Private Sub Command8_Click()
Form5.Show
End Sub

Private Sub Command9_Click()
Form6.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Form2
Unload Form3
Unload Form4
Unload Form5
Unload Form6
End Sub

Private Sub Text3_Change()
If Text3.Text > 60 Then
Text3.Text = 60
End If
End Sub

Private Sub Timer1_Timer()
Text1.Text = (Text1.Text) - 1
If Text1.Text = 0 Then
Timer2.Enabled = True
Text1.Text = 0
If Command6.Enabled = True Then
Command6_Click
End If
End If

Text2.Text = (Text2.Text) - 1
If Text2.Text = 0 Then
Timer2.Enabled = False
Text2.Text = 0
Command7_Click
End If
End Sub

Private Sub Timer2_Timer()
If filevar = "" Then
filevar = 0
End If
filevar = (filevar) + 1
Dim retval As Long
Dim loadStr As String

If Option5.Value = True Then

SavePicture Picture1.Image, "C:\tmp.bmp"
loadStr = (filepath) & "\" & filevar & ".jpg"

retval = DIWriteJpg(loadStr, hshQual.Value, chkProg.Value)

Kill "C:\tmp.bmp"
Else
SavePicture Picture1.Image, (filepath) & "\" & filevar & ".bmp"
End If
End Sub