Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Temas - TUNOVATO

#1
saludos tengo la idea de crear un proyecto ("menu de inicio" tipo  "U3 LAUNCH PAD") EN VISUAL BASIC QUE ME SIRVA PARA ORGANIZAR MI PENDRIVE,  de hecho por ahi hay muchos programitas de estos pero quiero uno personalizado y creado por mi necesitare de su valiosa colaboracion y ayuda de los que quieran colaborar; el mismo sera de codigo de funte anbierta y libre...!!!!!
#2
Luego de saludarles;

Paso a la explicacion (despues de haber leido y releido muchos postt relacionados con esta aplicacion) tengo muchas gana de aprender, pero he tenido varios problemas al tratar de terminar este proyecto (el mio) reconozco que los codigos no son muy eficientes y que tambien no son mios (de mi creacion), bueno despues de aclar esto paso a exponerles mi problema..... o mejor les publico el code del proyecto...!!!

FUNCIONES DE LA APLICACION:
1.- ES UNA APLICACION CLIENTE SERVIDOR (SERVIDOR/CLIENTE A LA INVERSA)

2.- TRANSMISION DE ARCHIVOS (IMAGENES) DEL SERVIDOR Y ENVIADAS AL CLIENTE (NO ENTIENDO MUY BIEN A PLENITUD LA TRANFERENCIA DE ARCHIVOS

3.- NO ENTIENDO QUE ERROR ESTOY COMETIENDO....!!!! (ME PODRIAN HACERLO VER, CORRIENDO ESTE CODE Y SEÑALARME LAS FALLLAS)



EL CLIENTE:


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



EL SERVIDOR:

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


Y UN MODULO LLAMADO  cJPEG.CLS


CODIGO DEL PROYECTO.....!!!
http://www.savefile.com/files/993534
#3
estoy intentando cargar una imagen que ha sido comprimido con el modulo clase CJpeg

este me arroja un errror al cargar la imagen

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



Error "481" en tiempo de ejecucion
la imagen no es valida...

nota: el codigo es copi paste (no es mio)
#4
Mi duda es como hacer que controles (listView) contenidos en un formulario se adapten a la variedad de tamaños de pantallas, es decir, 800*600 / 1024*768 / 1280*768 / 1280*1024 se adapte a ella sin descuadrarse ni su tamaño y ubicacion..!!!!

he buscado pero no he encotrado...!!!  a ver quie me puede ayudar

se que existe google.com , pero me presentan ocx de pago.!!!