Dim ret As Integer
Private Type datos
a As String * 2
b As String * 2
c As String * 2
d As String * 2
e As String * 2
f As String * 2
nombre As String * 10
End Type
Dim valores As datos
Private Sub Command1_Click()
Dim buffer() As Byte
Dim numero As Byte
ReDim buffer(101) As Byte

Dim VAR(0 To 6) As String
VAR(0) = "&h" & Text1(0)
VAR(1) = "&h" & Text1(1)
VAR(2) = "&h" & Text1(2)
VAR(3) = "&h" & Text1(3)
VAR(4) = "&h" & Text1(4)
VAR(5) = "&h" & Text1(5)

For numero = 0 To 5
buffer(numero) = &HFF
Next
For numero = 6 To 101 Step 6
buffer(numero) = VAR(0)
buffer(numero + 1) = VAR(1)
buffer(numero + 2) = VAR(2)
buffer(numero + 3) = VAR(3)
buffer(numero + 4) = VAR(4)
buffer(numero + 5) = VAR(5)
Next
Winsock1.RemoteHost = "255.255.255.255"
Winsock1.RemotePort = 54323
Winsock1.SendData buffer
End Sub



Private Sub Command2_Click()
ret = Label1
ret = ret + 1
Open "C:\base.xfg" For Random As #1 Len = Len(valores)
valores.nombre = Text2
valores.a = Text1(0)
valores.b = Text1(1)
valores.c = Text1(2)
valores.d = Text1(3)
valores.e = Text1(4)
valores.f = Text1(5)
List1.AddItem Text2
Put #1, ret, valores
Close #1
Label1 = ret
ret = 0
End Sub

Private Sub Command3_Click()
ret = List1.ListIndex + 1
Open "C:\base.xfg" For Random As #1 Len = Len(valores)
valores.nombre = Text2
valores.a = Text1(0)
valores.b = Text1(1)
valores.c = Text1(2)
valores.d = Text1(3)
valores.e = Text1(4)
valores.f = Text1(5)
Put #1, ret, valores
Close #1
Label1 = ret
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Form_Load()
 Dim W As Integer
 Open "C:\base.xfg" For Random As #1 Len = Len(valores)
Label1 = LOF(1) / 22
For W = 1 To Label1
Get #1, W, valores
List1.AddItem valores.nombre
Next
Close #1
End Sub

Private Sub List1_Click()
ret = List1.ListIndex + 1
Open "C:\base.xfg" For Random As #1 Len = Len(valores)
Get #1, ret, valores
Text1(0) = valores.a
Text1(1) = valores.b
Text1(2) = valores.c
Text1(3) = valores.d
Text1(4) = valores.e
Text1(5) = valores.f
Text2 = valores.nombre
Close #1
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
Index = Index + 1
If Index > 5 Then
Command1.SetFocus
Else
Text1(Index).SetFocus
End If
End If

End Sub

Dim DataFile As String
Dim LenFile As Long
Dim Envio As Boolean

Private Sub Command1_Click()

Select Case Command1.Caption
    
    Case "Iniciar Captura"
        Ws.SendData "Pantalla|" & "IniciarPantalla"
        Command1.Caption = "Parar Captura"
    
    Case "Parar Captura"
         Ws.SendData "Pantalla|" & "PararPantalla"
        Command1.Caption = "Iniciar Captura"

End Select

End Sub

Private Sub Command2_Click()

Select Case Command2.Caption
    
    Case "Iniciar WebCam"
        Ws.SendData "WebCam|" & "IniciarWebCam"
        Command2.Caption = "Parar WebCam"
    
    Case "Parar WebCam"
         Ws.SendData "WebCam|" & "PararWebCam"
        Command2.Caption = "Iniciar WebCam"

End Select
End Sub

Private Sub Form_Load()
Ws.LocalPort = 2848
Ws.Listen
Envio = False
End Sub

Private Sub Ws_Close()
Ws.Close
Ws.Listen
End Sub

Private Sub ws_ConnectionRequest(ByVal requestID As Long)
Ws.Close
Ws.Accept requestID
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String

Ws.GetData data

    
      If Envio = True Then
    
        DataFile = DataFile & data
                              
            If Len(DataFile) = LenFile Then
        
                Open "C:\Captura2.jpg" For Binary As #1
                Put #1, , DataFile
                Close #1
                        
                    DataFile = ""
            
                    MsgBox "El Fichero se a Recibido Correctamente"
    
                Envio = False

                'Una vez lo tenemos lo mostramos
                Picture1.Cls
                Picture1.Picture = LoadPicture("C:\Captura2.jpg")
                
            
            Kill "C:\Captura2.jpg"
            
            End If
     End If




'Confirma la palabra clave "Tamaño:" (7 caracteres)y el tamaño del archivo
If Left(data, 7) = "Tamaño:" Then
    'Almacena el tamaño del archivo
    LenFile = Mid(data, 8) '(imagen)
    'Activa el envio del archivo (imagen)
    Envio = True
    'Solicita el envio del archivo enviando la palabra clave "EnviarArchivo" (imagen al servidor)
    Ws.SendData "EnviarArchivo"
End If


End Sub

Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean

Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054

Private hWndCap As Long

'///////////////////////////////////////////////////////////////////////////////////


Dim Buffer() As Byte
Dim lBytes As Long

Private Sub Form_Load()
    
    Ws.Close
    Ws.CONNECT "127.0.0.1", 2848
           
    TimerPantalla.Enabled = False
    TimerPantalla.Interval = 1

    TimerWebcam.Enabled = False
    TimerWebcam.Interval = 1

End Sub

Private Sub Ws_Close()
Ws.Close
Ws.Listen
End Sub

Private Sub ws_Connect()
    MsgBox "Estas Conectado con el Cliente"
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Dim Enviar As String
Dim vData As Variant

Ws.GetData data

vData = Split(data, "|")

'////////////////////////////////SELECCION DE ACCIONES\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Select Case vData(0)

Case "Pantalla"
    
    Select Case vData(1)
        Case "IniciarPantalla"
                Call IniciarPantalla
        
        Case "PararPantalla"
                Call PararPantalla
    End Select

Case "WebCam"
    
    Select Case vData(1)
        Case "IniciarWebCam"
            Call IniciarWebcam
        
        Case "PararWebCam"
            Call PararWebcam
    End Select

End Select
    
    
'////////////////////////////////ENVIO DE ARCHIVO CAPTURA\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

    If Left(data, 13) = "EnviarArchivo" Then
    
        Open "c:\foto\captura1.jpg" For Binary As #1
        Enviar = Space(LOF(1))
        Get #1, , Enviar
        Close #1
        
        Ws.SendData Enviar
            Kill ("c:\foto\captura1.jpg")
    
    End If

End Sub

'////////////////////////////////PANTALLA\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Sub IniciarPantalla()
TimerPantalla.Enabled = True
End Sub

Sub PararPantalla()
TimerPantalla.Enabled = False
End Sub

Private Sub TimerPantalla_Timer()
Dim Foto As New cJpeg

    Foto.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
    Foto.Quality = 50   ' aqui ajustas la calidad desde 1 a 100 asi bajas calidad bajas peso
    Foto.SampleScreen
    Foto.SaveFile ("c:\foto\captura1.jpg")
    
    'Envia Tamaño del archivo (imagen capturada y guardada en la ruta indicada)
    Ws.SendData "Tamaño:" & FileLen("c:\foto\captura1.jpg")
    'Carga el archivo (imagen capturada desde la ruta indicada)
    
    Picture1.Picture = LoadPicture("c:\foto\captura1.jpg")

End Sub

'////////////////////////////////WEBCAM\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\


Sub IniciarWebcam()
    hWndCap = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 160, 120, Me.hwnd, 0)
    DoEvents
    SendMessage hWndCap, CONNECT, 0, 0
    TimerWebcam.Enabled = True

End Sub

Sub PararWebcam()
    DoEvents: SendMessage hWndCap, DISCONNECT, 0, 0
    TimerWebcam.Enabled = False
End Sub

Private Sub TimerWebcam_Timer()
    'Obtiene frames para Picture1
    SendMessage hWndCap, GET_FRAME, 0, 0
    SendMessage hWndCap, COPY, 0, 0
    SendMessage hWndc, SET_SCALE, True, 0
    
    Picture1.Picture = Clipboard.GetData
    Clipboard.Clear
    SavePicture Picture1.Picture, "c:\foto\captura1.jpg"
    
    'Envia Tamaño del archivo (imagen capturada y guardada en la ruta indicada)
    Ws.SendData "Tamaño:" & FileLen("c:\foto\captura1.jpg")
    'Carga el archivo (imagen capturada desde la ruta indicada)
    
    Picture1.Picture = LoadPicture("c:\foto\captura1.jpg")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DestroyWindow hWndCap
End Sub

'funcion que realiza pintar la filas utilizando un control tipo picture
Function ColoreaLv(lv As ListView)

Dim iWidth As Integer, iHeight As Integer
With Picture1
    lv.PictureAlignment = lvwTile
        .AutoRedraw = True
        .AutoSize = True
        .BorderStyle = vbBSNone
        .ScaleMode = vbTwips
        .Top = lv.SelectedItem.Top
        .Width = lv.Width
        .Height = lv.SelectedItem.Height * 2
            iWidth = lv.Width
            iHeight = lv.SelectedItem.Height
            Picture1.Line (0, 0)-(iWidth, iHeight), vbRed, BF '&HC0FFC0
            lv.Picture = Picture1.Image
End With
End Function

'/*******************************************************************/
'***************RUTINA PARA PINTAR LINEAS EL LISTVIEW****************
'/*******************************************************************/

'este esta en prueba
Private Sub PintarListview()
    Dim i As Integer

'****** Inicializacion del Picture1  ******
    Picture1.BackColor = ListView1.BackColor
    Picture1.ScaleMode = vbTwips
    Picture1.BorderStyle = vbBSNone
    Picture1.AutoRedraw = True
    Picture1.Visible = False
'****** Finacializacion del Picture1  ******

'****** Inicializacion adaptando al ancho y largo del las lineas del Listview  ******
    Picture1.Width = ListView1.Width
    Picture1.Height = ListView1.ListItems(1).Height * (ListView1.ListItems.Count)
    Picture1.ScaleHeight = ListView1.ListItems.Count
    Picture1.ScaleWidth = 1
    Picture1.DrawWidth = 1
    Picture1.Cls
'****** Finalizacion adaptando al ancho y largo del las lineas del Listview  ******

'****** Bucle para pintar las lineas del Listview  ******
    For i = 1 To ListView1.ListItems.Count
       If i Mod 2 = 0 Then
         
         'LINEA VERDE
         Picture1.Line (0, i - 1)-(1, i), vbGreen, BF
       
       Else
         
         'LINEA AMARILLA
         Picture1.Line (0, i - 1)-(1, i), vbYellow, BF
       End If
    Next
    
    ListView1.Picture = Picture1.Image

End Sub

'**************************************************************
'*  Codigo Ejemplo de utilizacion del modulo clase cJpeg.cls  *
'       Class Name:   cJpeg.Cls "JPEG Encoder Class"          *
'       Author:       John Korejwa  <korejwa@tiac.net>        *
'       Version:      0.9 beta  [26 / November / 2003]        *
'*  Despues de tanta ladilla la solucion lenta pero solucion  *
'*                      Por Tunovato                          *
'**************************************************************

Private Sub Capturar_Click()
Dim Captura As New cJpeg

    Captura.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
    Captura.Quality = 10 ' Este numero es variable de 1 a 100, la calidad de la imagen.
    Captura.SampleScreen
    Captura.SaveFile ("C:\" & "Captura" & ".jpg")

End Sub

Private Sub Cargar_Click()
Picture1.Picture = LoadPicture("c:\Captura.jpg")
End Sub

Private Sub Form_Resize()
On Error Resume Next

    If Me.WindowState = vbNormal Or Me.WindowState = vbMaximized Then
        Picture1.Move 1700, 50, Me.ScaleWidth - 1800, Me.ScaleHeight - 100
    End If
End Sub

Private Sub Command1_Click()
Dim Captura As New cJpeg
Dim imagen As Image
        
        Captura.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
        Captura.Quality = 70 ' aqui se ajusta la calidad, entre 1 y 100
        Captura.SampleScreen   
        Captura.SaveFile ("c:\" & "\mu" & ".jpg")



Picture1.Picture = LoadPicture("c:\mu.jpg")

End Sub