form1.frm

Program in vb to convert to jpg of bmp

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "DLL ActiveX para Exportar a JPG"
   ClientHeight    =   3330
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7155
   LinkTopic       =   "Form1"
   ScaleHeight     =   3330
   ScaleWidth      =   7155
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   435
      Left            =   5370
      TabIndex        =   3
      Top             =   1950
      Width           =   1185
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      Left            =   3840
      Max             =   100
      TabIndex        =   1
      Top             =   840
      Value           =   85
      Width           =   1935
   End
   Begin VB.Frame Frame1 
      Caption         =   "Imagen"
      Height          =   3135
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3615
      Begin VB.PictureBox Picture1 
         Height          =   2385
         Left            =   330
         ScaleHeight     =   2325
         ScaleWidth      =   2865
         TabIndex        =   4
         Top             =   540
         Width           =   2925
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Valor de compresi髇"
      Height          =   195
      Left            =   3840
      TabIndex        =   2
      Top             =   480
      Width           =   1440
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Constantes para pasar a la funci髇 Api CopyImage
Private Const IMAGE_BITMAP = 0
Private Const LR_COPYRETURNORG = &H4
Private Const CF_BITMAP = 2

'Funciones Api para el manejo del portapapeles
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long

'Funci髇 Api CopyImage para copiar una im醙en
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal imageType As Long, ByVal newWidth As Long, ByVal newHeight As Long, ByVal lFlags As Long) As Long
'--bd
Private id As Long

Dim mensaje As String

Sub empezar()
    Dim lpszName As String * 100
    Dim lpszVer As String * 100
    Dim Caps As CAPDRIVERCAPS
        
    '//Create Capture Window
    capGetDriverDescriptionA 0, lpszName, 100, lpszVer, 100  '// Retrieves driver info
    lwndC = capCreateCaptureWindowA(lpszName, WS_CAPTION Or WS_THICKFRAME Or WS_VISIBLE Or WS_CHILD, 0, 1, 160, 120, Me.hWnd, 0)

    '// Set title of window to name of driver
    SetWindowText lwndC, lpszName
    
    '// Set the video stream callback function
    capSetCallbackOnStatus lwndC, AddressOf MyStatusCallback
    capSetCallbackOnError lwndC, AddressOf MyErrorCallback
    
    '// Connect the capture window to the driver
    If capDriverConnect(lwndC, 0) Then
        '/////
        '// Only do the following if the connect was successful.
        '// if it fails, the error will be reported in the call
        '// back function.
        '/////
        '// Get the capabilities of the capture driver
        capDriverGetCaps lwndC, VarPtr(Caps), Len(Caps)
        
        '// If the capture driver does not support a dialog, grey it out
        '// in the menu bar.
        Caps.fHasDlgVideoSource = 0
        Caps.fHasDlgVideoFormat = 0
        Caps.fHasDlgVideoDisplay = 0
        
        '// Turn Scale on
        capPreviewScale lwndC, True
            
        '// Set the preview rate in milliseconds
        capPreviewRate lwndC, 66
        
        '// Start previewing the image from the camera
        capPreview lwndC, True
        
            
        '// Resize the capture window to show the whole image
      '  ResizeCaptureWindow lwndC

    End If

End Sub


Private Sub Command1_Click()
    capEditCopy lwndC
    Picture1.Picture = Clipboard.GetData(2)
    Call SavePicture(Picture1, "c:\temp.bmp")
    Call convertir("temp")
    Unload Me
End Sub
Sub convertir(nombre As String)
    On Error GoTo Form_Load_Error
    Dim Conversor As Class1
    Set Conversor = New Class1
    'Picture1.Picture = LoadPicture("temp.bmp")
    'Si el picture no contiene una imagen valida deshabilitamos el command guardar
    HScroll1.Value = 60
    Conversor.GrabarJpg Picture1, nombre & ".jpg", CByte(HScroll1.Value)
    Set Conversor = Nothing
    
    On Error GoTo 0
    Exit Sub
Form_Load_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Load of Formulario Form1"
End Sub


Private Sub Form_Load()
    empezar
End Sub
''-------------------------------

Private Sub Form_Unload(Cancel As Integer)
  
    '// Disable all callbacks
    capSetCallbackOnError lwndC, vbNull
    capSetCallbackOnStatus lwndC, vbNull
    capSetCallbackOnYield lwndC, vbNull
    capSetCallbackOnFrame lwndC, vbNull
    capSetCallbackOnVideoStream lwndC, vbNull
    capSetCallbackOnWaveStream lwndC, vbNull
    capSetCallbackOnCapControl lwndC, vbNull
     '   If cn.State = adStateOpen Then
     '  cn.Close
    'End If
End Sub