elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Guía actualizada para evitar que un ransomware ataque tu empresa


  Mostrar Temas
Páginas: 1 2 3 4 5 6 7 8 9 10 11 [12] 13
111  Programación / Programación Visual Basic / [Source] Funciones para marcar contornos de una imagen y marcar piel. en: 6 Diciembre 2010, 14:26 pm
HOLA!!!

EFECTO:


Gracias a LEANDRO A pude armar una funcion que convierte una imagen cualquiera a una imagen en ByN puro sin escala de grises marcando solamente los contornos de las cosas.

AGREGADO: funcion para pintar las zonas que son piel.



Hay una variable "Tolerance" esa la regulan para que sea mas o menos estricto con la deteccion de bordes.

Bueno aca el codigo (Modulo):
Repito GRACIAS LEA!
Código
  1. Option Explicit
  2. Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO24, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
  3. Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  4. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  5. Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
  6. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  7. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  8. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  9. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  10. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  11. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
  12.  
  13. Private Type RGBQUAD
  14.    rgbBlue As Byte
  15.    rgbGreen As Byte
  16.    rgbRed As Byte
  17.    rgbReserved As Byte
  18. End Type
  19.  
  20. Private Type BITMAPINFOHEADER
  21.    biSize As Long
  22.    biWidth As Long
  23.    biHeight As Long
  24.    biPlanes As Integer
  25.    biBitCount As Integer
  26.    biCompression As Long
  27.    biSizeImage As Long
  28.    biXPelsPerMeter As Long
  29.    biYPelsPerMeter As Long
  30.    biClrUsed As Long
  31.    biClrImportant As Long
  32. End Type
  33.  
  34. Private Type BITMAPINFO24
  35.    bmiHeader As BITMAPINFOHEADER
  36.    bmiColors() As RGBQUAD
  37. End Type
  38.  
  39. Private Type SAFEARRAYBOUND
  40.    cElements As Long
  41.    lLbound As Long
  42. End Type
  43.  
  44. Private Type SAFEARRAY2D
  45.    cDims As Integer
  46.    fFeatures As Integer
  47.    cbElements As Long
  48.    cLocks As Long
  49.    pvData As Long
  50.    Bounds(0 To 1) As SAFEARRAYBOUND
  51. End Type
  52.  
  53.  
  54. Private Const DIB_RGB_COLORS = 0
  55. Private Const BI_RGB = 0&
  56.  
  57.  
  58. Public Sub BuscarContornos(Pic As PictureBox)
  59.    Dim BytesPerLine As Long
  60.    Dim WinDC As Long
  61.    Dim TmpDC As Long
  62.    Dim hBmp As Long
  63.    Dim OldBmp As Long
  64.    Dim Addrs As Long
  65.    Dim x As Long
  66.    Dim y As Long
  67.    Dim lpBits() As Byte
  68.    Dim M_BitmapInfo As BITMAPINFO24
  69.    Dim SA As SAFEARRAY2D
  70.    Dim R As Byte, G As Byte, B As Byte, BYN As Byte, Tolerance As Byte
  71.    Dim ZERO As Integer
  72.    Dim tmp1 As Integer, tmp2 As Integer, tmp3 As Integer
  73.    Tolerance = 20
  74.    ZERO = 0
  75.    BytesPerLine = ScanAlign(Pic.ScaleWidth * 3)
  76.  
  77.    With M_BitmapInfo.bmiHeader
  78.        .biSize = Len(M_BitmapInfo.bmiHeader)
  79.        .biWidth = Pic.ScaleWidth
  80.        .biHeight = Pic.ScaleHeight
  81.        .biPlanes = 1
  82.        .biBitCount = 24
  83.        .biCompression = BI_RGB
  84.        .biSizeImage = BytesPerLine * Pic.ScaleHeight
  85.    End With
  86.  
  87.    WinDC = GetDC(0)
  88.    TmpDC = CreateCompatibleDC(WinDC)
  89.    hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0)
  90.  
  91.    Call ReleaseDC(0, WinDC)
  92.  
  93.    With SA
  94.        .cbElements = 1
  95.        .cDims = 2
  96.        .Bounds(0).lLbound = 0
  97.        .Bounds(0).cElements = Pic.ScaleHeight
  98.        .Bounds(1).lLbound = 0
  99.        .Bounds(1).cElements = BytesPerLine
  100.        .pvData = Addrs
  101.    End With
  102.  
  103.    CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4
  104.  
  105.    OldBmp = SelectObject(TmpDC, hBmp)
  106.  
  107.    Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy)
  108.  
  109.    For y = 0 To Pic.ScaleHeight - 1
  110.        For x = 0 To (Pic.ScaleWidth * 3) - 1 Step 3
  111.  
  112.            B = lpBits(x + 2, y)
  113.            G = lpBits(x + 1, y)
  114.            R = lpBits(x, y)
  115.  
  116.  
  117.            'ZERO ES PARA QUE NO HAGA DESBORDAMIENTO
  118.            BYN = Int((ZERO + R + G + B) / 3)
  119.  
  120.            'DIBUJA EN BLANCO Y NEGRO
  121.  
  122.            lpBits(x, y) = BYN
  123.            lpBits(x + 1, y) = BYN
  124.            lpBits(x + 2, y) = BYN
  125.            If x <> 0 And y <> 0 Then
  126.            tmp1 = lpBits(x - 1, y - 1)
  127.            tmp2 = lpBits(x - 1, y)
  128.            tmp3 = lpBits(x, y - 1)
  129.            If Abs(tmp2 - tmp1) > Tolerance Or Abs(tmp3 - tmp1) > Tolerance Then
  130.                lpBits(x - 1, y - 1) = 0
  131.                lpBits(x - 2, y - 1) = 0
  132.                lpBits(x - 3, y - 1) = 0
  133.            Else
  134.                'PINTA DE NEGRO EL PIXEL POR QUE AHI HAY UN BORDE
  135.                lpBits(x - 1, y - 1) = 255
  136.                lpBits(x - 2, y - 1) = 255
  137.                lpBits(x - 3, y - 1) = 255
  138.            End If
  139.            End If
  140.        Next x
  141.    Next y
  142.  
  143.    CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
  144.    Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy)
  145.    Call DeleteObject(SelectObject(TmpDC, OldBmp))
  146.    Call DeleteDC(TmpDC)
  147.  
  148.  
  149.  
  150. End Sub
  151.  
  152. Public Sub BuscarPiel(Pic As PictureBox)
  153.    Dim BytesPerLine As Long
  154.    Dim WinDC As Long
  155.    Dim TmpDC As Long
  156.    Dim hBmp As Long
  157.    Dim OldBmp As Long
  158.    Dim Addrs As Long
  159.    Dim x As Long
  160.    Dim y As Long
  161.    Dim lpBits() As Byte
  162.    Dim M_BitmapInfo As BITMAPINFO24
  163.    Dim SA As SAFEARRAY2D
  164.    Dim R As Byte, G As Byte, B As Byte, BYN As Byte, Tolerance As Byte
  165.    Dim ZERO As Integer
  166.    Dim tmp1 As Integer, tmp2 As Integer, tmp3 As Integer
  167.    Tolerance = 20
  168.    ZERO = 0
  169.    BytesPerLine = ScanAlign(Pic.ScaleWidth * 3)
  170.  
  171.    With M_BitmapInfo.bmiHeader
  172.        .biSize = Len(M_BitmapInfo.bmiHeader)
  173.        .biWidth = Pic.ScaleWidth
  174.        .biHeight = Pic.ScaleHeight
  175.        .biPlanes = 1
  176.        .biBitCount = 24
  177.        .biCompression = BI_RGB
  178.        .biSizeImage = BytesPerLine * Pic.ScaleHeight
  179.    End With
  180.  
  181.    WinDC = GetDC(0)
  182.    TmpDC = CreateCompatibleDC(WinDC)
  183.    hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0)
  184.  
  185.    Call ReleaseDC(0, WinDC)
  186.  
  187.    With SA
  188.        .cbElements = 1
  189.        .cDims = 2
  190.        .Bounds(0).lLbound = 0
  191.        .Bounds(0).cElements = Pic.ScaleHeight
  192.        .Bounds(1).lLbound = 0
  193.        .Bounds(1).cElements = BytesPerLine
  194.        .pvData = Addrs
  195.    End With
  196.  
  197.    CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4
  198.  
  199.    OldBmp = SelectObject(TmpDC, hBmp)
  200.  
  201.    Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy)
  202.  
  203.    For y = 0 To Pic.ScaleHeight - 1
  204.        For x = 0 To (Pic.ScaleWidth * 3) - 1 Step 3
  205.  
  206.            R = lpBits(x + 2, y)
  207.            G = lpBits(x + 1, y)
  208.            B = lpBits(x, y)
  209.  
  210.  
  211.            'ZERO ES PARA QUE NO HAGA DESBORDAMIENTO
  212.            BYN = Int((ZERO + R + G + B) / 3)
  213.  
  214.            'DIBUJA EN BLANCO Y NEGRO
  215.            If R > 168 And G > 134 And B > 94 And R < 250 And G < 235 And B < 215 Then
  216.            ' LOS PROXIMOS 3 VALORES ESPECIFICAN EL COLOR CON EL QUE SE VA A PINTAR
  217.            lpBits(x, y) = 0
  218.            lpBits(x + 1, y) = 255
  219.            lpBits(x + 2, y) = 255
  220.            Else
  221.            lpBits(x, y) = 0 ' BYN
  222.            lpBits(x + 1, y) = 0 'BYN
  223.            lpBits(x + 2, y) = 0 'BYN
  224.            End If
  225.        Next x
  226.    Next y
  227.  
  228.    CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
  229.    Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy)
  230.    Call DeleteObject(SelectObject(TmpDC, OldBmp))
  231.    Call DeleteDC(TmpDC)
  232.  
  233.  
  234.  
  235. End Sub
  236.  
  237. Private Function ScanAlign(WidthBmp As Long) As Long
  238.    ScanAlign = (WidthBmp + 3) And &HFFFFFFFC
  239. End Function
  240.  
  241.  

Para llamar la funcion:
Código
  1. Private Sub Command1_Click()
  2.    'ESTO PARA CONTORNOS
  3.    BuscarContornos PicTratamiento
  4.    'ESTO PARA PIEL
  5.    BuscarPiel PicTratamiento
  6.    PicTratamiento.Refresh
  7. End Sub
  8.  
  9. Private Sub Form_Load()
  10.    PicTratamiento.AutoRedraw = True
  11.    PicTratamiento.ScaleMode = vbPixels
  12. End Sub

P.D: El de la foto soy yo asi que no puteen.
GRACIAS POR LEER!!!
112  Programación / Programación Visual Basic / [Ayuda]Reconocer contornos Picturebox en: 3 Diciembre 2010, 16:14 pm
HOLA!!!

Como andan?, hoy tengo una duda, estoy intentando encontrar los contornos de los objetos de una foto(en un picturebox) logre armar algo buscando en google, pero es  muy inpresiso.

La imagen se trata en un Picturebox chico asi no tarda mucho, sino se come el procesador.

Si encuentran algo o ven algo en mi codigo avisenme.

Bueno, les dejo mi codigo para que lo vean.
Esto va en un modulo y en el Form1 ponen un picturebox con una imagen (chica :P) hacen un call a la funcion y listo.
Código
  1. Public color As Long
  2. Public ElR As Byte
  3. Public ElG As Byte
  4. Public ElB As Byte
  5. Dim P12 As Integer, P21 As Integer, P22 As Integer
  6.  
  7. Public Sub RGBdelPixel(x As Integer, y As Integer)
  8.   color = Form1.PicTratamiento.Point(x - 1, y)
  9.   ElB = (color \ 65536) And &HFF
  10.   ElG = (color \ 256) And &HFF
  11.   ElR = color And &HFF
  12.   P12 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
  13.   color = Form1.PicTratamiento.Point(x, y - 1)
  14.   ElB = (color \ 65536) And &HFF
  15.   ElG = (color \ 256) And &HFF
  16.   ElR = color And &HFF
  17.   P21 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
  18.   color = Form1.PicTratamiento.Point(x, y)
  19.   ElB = (color \ 65536) And &HFF
  20.   ElG = (color \ 256) And &HFF
  21.   ElR = color And &HFF
  22.   P22 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
  23. End Sub
  24.  
  25. Public Sub Contornos()
  26. Dim AltUrA As Integer, lArgO As Integer, color As Integer
  27. Dim i As Integer, j As Integer
  28. Form1.PicTratamiento.ScaleMode = 3
  29. AltUrA = Form1.PicTratamiento.ScaleHeight
  30. lArgO = Form1.PicTratamiento.ScaleWidth
  31. tolerancia = 100
  32.  
  33. For i = 1 To lArgO - 1
  34.    For j = 1 To AltUrA - 1
  35.        RGBdelPixel i, j
  36.        If Abs(P12 - P22) > tolerancia Or Abs(P21 - P22) > tolerancia Then
  37.            Form1.PicTratamiento.PSet (i, j) ', RGB(P22, P22, P22)
  38.        Else
  39.            Form1.PicTratamiento.PSet (i, j), vbWhite
  40.        End If
  41. Next
  42. Next
  43. Form1.PicTratamiento.ScaleMode = 1
  44. End Sub

GRACIAS POR LEER!!!
113  Programación / Programación Visual Basic / [Juego] Tragamonedas. en: 5 Noviembre 2010, 18:49 pm
HOLA!!!

Hola, hoy les traigo un tragamonedas, lo programe hoy asi que puede ser que tenga algun que otro bug, digan si encuentran :D.

Es asi:



El codigo:
Código
  1. Private tabla(15) As Byte
  2. Private DETENER As Boolean
  3. Private LINEAS As Byte
  4. Private MONEDAS As Boolean
  5. Private DINERO As Double
  6. Private DIB2(15) As Byte 'REPRESENTA LOS DIBUJOS EN CODIGO
  7. Private BASE(3) As Integer
  8. Dim CODIGO As String
  9. Dim LIN As String
  10. Dim DIN As Integer
  11. Dim RESTA As Byte
  12.  
  13.  
  14. Private Sub Form_Load()
  15. LINEAS = 1
  16. DINERO = 100
  17. MONEDAS = False
  18. Dim x As Byte
  19. For x = 1 To 5
  20. tabla(x) = x
  21. If x >= 2 Then tabla(x + 4) = x
  22. If x >= 3 Then tabla(x + 7) = x
  23. If x >= 4 Then tabla(x + 9) = x
  24. Next
  25. tabla(15) = 5
  26. End Sub
  27.  
  28.  
  29. Private Sub Go_Click()
  30. Dim AP As Byte ' apuesta
  31. AP = LINEAS
  32. If MONEDAS = True Then AP = LINEAS * 2
  33. If AP <= DINERO Then
  34. Girar.Interval = 30
  35. STOPTIM.Interval = 1000
  36. Go.Enabled = False
  37. Else
  38. MsgBox "Estas apostando mas de lo que tienes", , "Atencion"
  39. End If
  40. End Sub
  41.  
  42. Private Sub Girar_Timer()
  43. Randomize
  44.    Dim x As Byte
  45.    Dim VUELTA As Byte ' REPRESENTA LA CANTIDAD DE VECES QUE MANDO UN DIBUJO ARRIBA
  46.    For x = 0 To 14
  47.        DIB1(x).Top = DIB1(x).Top + 150
  48.        If DIB1(x).Top >= 2430 Then
  49.            VUELTA = VUELTA + 1
  50.            DIB1(x).Top = -1330
  51.            If DETENER = True Then Girar.Interval = 0
  52.            RAN = tabla(1 + Int(Rnd() * 14))
  53.            DIB1(x).Picture = LoadPicture(App.Path & "/Images/T (" & RAN & ").jpg")
  54.            DIB2(x) = RAN
  55.            BASE(VUELTA) = x - 1
  56.            If BASE(VUELTA) = -1 Then BASE(VUELTA) = 4
  57.            If BASE(VUELTA) = 4 Then BASE(VUELTA) = 9
  58.            If BASE(VUELTA) = 9 Then BASE(VUELTA) = 14
  59.        End If
  60.    Next
  61.    VUELTA = 0
  62.    If DETENER = True And Girar.Interval = 0 Then
  63.        DETENER = False
  64.        Call Calcular
  65.    End If
  66. End Sub
  67.  
  68. Private Sub MAS_Click()
  69. LBLLIN.Caption = Trim(Str(Val(Mid(LBLLIN.Caption, 1, 1)) + 1)) & " LINEAS"
  70. If LBLLIN.Caption = "6 LINEAS" Then LBLLIN.Caption = "5 LINEAS"
  71. LINEAS = Str(Val(Mid(LBLLIN.Caption, 1, 1)))
  72. End Sub
  73.  
  74. Private Sub MENOS_Click()
  75. LBLLIN.Caption = Trim(Str(Val(Mid(LBLLIN.Caption, 1, 1)) - 1)) & " LINEAS"
  76. If LBLLIN.Caption = "0 LINEAS" Then LBLLIN.Caption = "1 LINEA"
  77. If LBLLIN.Caption = "1 LINEAS" Then LBLLIN.Caption = "1 LINEA"
  78. LINEAS = Str(Val(Mid(LBLLIN.Caption, 1, 1)))
  79. End Sub
  80.  
  81. Private Sub Option1_Click(Index As Integer)
  82. MONEDAS = False
  83. If Index = 1 Then MONEDAS = True
  84. End Sub
  85.  
  86. Private Sub STOPTIM_Timer()
  87. STOPTIM.Interval = 0
  88. StopX.Enabled = True
  89. End Sub
  90.  
  91. Private Sub StopX_Click()
  92. DETENER = True
  93. Go.Enabled = True
  94. StopX.Enabled = False
  95. End Sub
  96.  
  97. Private Sub Calcular()
  98. CODIGO = ""
  99. DIN = 0
  100. 'HORIZONTALES
  101. For x = 0 To 2
  102.    If x = 0 Then
  103.        CODIGO = CODIGO & DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x)
  104.    ElseIf x = 1 Then
  105.        If BASE(1) = 0 Then
  106.        CODIGO = DIB2(4) & DIB2(9) & DIB2(14) & CODIGO
  107.        Else
  108.        CODIGO = DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x) & CODIGO
  109.        End If
  110.    ElseIf x = 2 Then
  111.        If BASE(1) = 0 Then
  112.        CODIGO = CODIGO & DIB2(3) & DIB2(8) & DIB2(13)
  113.        ElseIf BASE(1) = 1 Then
  114.        CODIGO = CODIGO & DIB2(4) & DIB2(9) & DIB2(14)
  115.        Else
  116.        CODIGO = CODIGO & DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x)
  117.        End If
  118.    End If
  119. Next
  120. 'DIAGONAL 1
  121. If BASE(1) = 0 Then
  122.    CODIGO = CODIGO & DIB2(3) & DIB2(9) & DIB2(10)
  123. ElseIf BASE(1) = 1 Then
  124.    CODIGO = CODIGO & DIB2(4) & DIB2(5) & DIB2(11)
  125. ElseIf BASE(1) = 2 Then
  126.    CODIGO = CODIGO & DIB2(0) & DIB2(6) & DIB2(12)
  127. ElseIf BASE(1) = 3 Then
  128.    CODIGO = CODIGO & DIB2(1) & DIB2(7) & DIB2(13)
  129. ElseIf BASE(1) = 4 Then
  130.    CODIGO = CODIGO & DIB2(2) & DIB2(8) & DIB2(14)
  131. End If
  132. 'DIAGONAL 2
  133. If BASE(1) = 0 Then
  134.    CODIGO = CODIGO & DIB2(0) & DIB2(9) & DIB2(13)
  135. ElseIf BASE(1) = 1 Then
  136.    CODIGO = CODIGO & DIB2(1) & DIB2(5) & DIB2(14)
  137. ElseIf BASE(1) = 2 Then
  138.    CODIGO = CODIGO & DIB2(2) & DIB2(6) & DIB2(10)
  139. ElseIf BASE(1) = 3 Then
  140.    CODIGO = CODIGO & DIB2(3) & DIB2(7) & DIB2(11)
  141. ElseIf BASE(1) = 4 Then
  142.    CODIGO = CODIGO & DIB2(4) & DIB2(8) & DIB2(12)
  143. End If
  144. For x = 0 To LINEAS - 1
  145.    LIN = Mid(CODIGO, x * 3 + 1, 3)
  146.    If LIN = "111" Then DIN = DIN + 2000
  147.    If LIN = "222" Then DIN = DIN + 200
  148.    If LIN = "333" Then DIN = DIN + 50
  149.    If LIN = "444" Then DIN = DIN + 30
  150.    If LIN = "555" Then DIN = DIN + 10
  151.    Dim Y As Byte
  152.    If Not LIN = "555" And (Mid(LIN, 1, 2) = "55" Or Mid(LIN, 2, 2) = "55") Then DIN = DIN + 5
  153. Next
  154. If MONEDAS = True Then DIN = DIN * 2
  155. RESTA = LINEAS
  156. If MONEDAS = True Then RESTA = LINEAS * 2
  157. DINERO = DINERO + DIN - RESTA
  158. lbldin.Caption = "$ " & DINERO
  159. End Sub
  160.  

Source con el ejecutable:

Descargar URL:
http://www.gigasize.com/get.php?d=mkrb3z3ylyb

Mirror:
http://hotfile.com/dl/80628928/841f839/Tragamonedas.rar.html

GRACIAS POR LEER!!!
114  Programación / Programación Visual Basic / [Solucionado] Proyecto Reconocimiento facial. Donde Empezar. en: 7 Octubre 2010, 14:27 pm
HOLA!!!

Hoy vengo con algo medio ambicioso para vb6, creo que el programa no da para hacer una rutina rápida y a la vez fiable de reconocimiento de Rostros.

Ni empece con el código, es solo un proyecto que quisiera hacer, pero no se ni por donde empezar.

Según lo que tengo visto tendría que hacerlo en C pelado por su velocidad pero el tema es que este lenguaje lo se leer y programar cosas muy simples, ni hablar hacer un llamado a la webcam y demás.

Si alguien quiere sumarse por favor avise y vemos como hacemos.

Lo que se me había ocurrido era un programa en VB6 que maneje las bases de datos y que cada vez que quiera hacer un reconocimiento envié un comando a un programa en C el cual analizaría el Rostro y enviaría un integer que correspondería al numero del rostro analizado al programa en VB6 que mostraría todo lindo.

En definitiva donde buscar info, lo que hay en Google es o muy complejo o muy basico; y por supuesto si alguien quiere ayudar con el tema.

Espero respuestas y opiniones.

GRACIAS POR LEER!!!
115  Programación / Programación Visual Basic / [Soft] Contador de lineas logicas en: 6 Octubre 2010, 13:38 pm
HOLA!!!

Dejaria el code pero no es mio, solo tengo el ejecutable.

Este programa por lo menos yo lo uso para saber cuanto cobrar por programa y por modificacion que pida el cliente.

Lo unico que tienen que pensar es cuanto vale una linea de Su codigo.

(No hagan if de una linea :P)

Jajaja. en definitiva sirve para poder cobrar bien los trabajos y con fundamento.

P.D: No soporta Grupos de proyectos. hay que hacer por cada proyecto por separado.

Descargar URL:
http://www.gigasize.com/get.php?d=m056othh8vf

Mirror:
http://hotfile.com/dl/74175182/4b2e896/CONTADOR_DE_LINEAS_LOGICAS.rar.html

GRACIAS POR LEER!!!
116  Programación / Programación Visual Basic / [Juego] Bah broma informatica. Lean adentro por que es larga la descripcion. en: 1 Octubre 2010, 19:04 pm
HOLA!!!

Este codigo lo hice tambien cuando era mas chico. Lo que hace el programa es:

1- minimiza todo
2- saca una foto del escritorio
3- la guarda
4- la establece como fondo de escritorio
5- oculta los iconos
6- espera el tiempo en el timer4 y muestra los iconos de nuevo.

Es en definitiva para reirse un poco.


timer1 con intervalo 1
timer3 con intervalo 800
timer4 con intervalo 60000
Código
  1. 'Función Api FindWindowEx
  2. Private Declare Function FindWindowEx Lib "user32" _
  3. Alias "FindWindowExA" (ByVal hWnd1 As Long, _
  4. ByVal hWnd2 As Long, ByVal lpsz1 As String, _
  5. ByVal lpsz2 As String) As Long
  6.  
  7. 'Función Api ShowWindow
  8. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
  9. ByVal nCmdShow As Long) As Long
  10.  
  11. 'Constantes para ocultar y mostrar los iconos del escritorio
  12. Const SW_SHOW = 5
  13. Const SW_HIDE = 0
  14.  
  15.  
  16.  'Api para generar un evento de Print Screen
  17. Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
  18.                                     ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
  19.  
  20.  Private Declare Function CAMBIOESC Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
  21.  Public X As Integer
  22.    Public F As Integer
  23.    Public Y As Integer
  24.  
  25. 'recibe la ruta donde crear el BMP
  26. ''''''''''''''''''''''''''''''''''''''''''''''''''
  27. Private Sub MINIMIZAR()
  28.  
  29. 'Constantes
  30. Const KEYEVENTF_KEYUP = &H2
  31. Const VK_LWIN = &H5B
  32.  
  33. Call keybd_event(VK_LWIN, 0, 0, 0)
  34. Call keybd_event(77, 0, 0, 0)
  35. Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
  36.  
  37. End Sub
  38.  
  39.  
  40. Private Sub Capturar_Guardar(Path As String)
  41.  
  42.     ' borra el portapapeles
  43.     Clipboard.Clear
  44.  
  45.     ' Manda la pulsación de teclas para capturar la imagen de la pantalla
  46.     Call keybd_event(44, 2, 0, 0)
  47.  
  48.     DoEvents
  49.     ' Si el formato del clipboard es un bitmap
  50. If Clipboard.GetFormat(vbCFBitmap) Then
  51.  
  52.         'Guardamos la imagen en disco
  53.         SavePicture Clipboard.GetData(vbCFBitmap), Path
  54.  
  55. End If
  56.  
  57. End Sub
  58. Private Sub CAMBIOESCRITORIO()
  59. Dim CAMBIO As Integer
  60. CAMBIO = CAMBIOESC(20, 0, "c:\pantalla.bmp", 0)
  61. End Sub
  62. Private Sub Form_Load()
  63. X = 0
  64. F = 0
  65. End Sub
  66. Private Sub Timer1_Timer()
  67. If X = 0 Then
  68.    Call MINIMIZAR
  69.    X = 1
  70. End If
  71. End Sub
  72.  
  73.  
  74. Private Sub Timer3_Timer()
  75. Call Capturar_Guardar("c:\pantalla.bmp")
  76.    If F = 0 Then
  77.    Call CAMBIOESCRITORIO
  78.    Dim Ret As Long
  79.  
  80. On Error Resume Next
  81. 'Obtenemos el Hwnd del escritorio pasandole el nombre de la clase de ventana, en este caso Progman es el escritorio
  82. Ret = FindWindowEx(0&, 0&, "Progman", vbNullString)
  83.  
  84. 'Ocultamos los iconos pasandole a ShowWindow el Hwnd del escritorio
  85. ShowWindow Ret, SW_HIDE
  86.    F = 1
  87.    End If
  88.  
  89. End Sub
  90.  
  91. Private Sub Timer4_Timer()
  92. 'Para Mostrar los iconos
  93. Dim Ret As Long
  94. On Error Resume Next
  95. 'Obtenemos el Hwnd del escritorio
  96. Ret = FindWindowEx(0&, 0&, "Progman", vbNullString)
  97.  
  98. 'Mostramos los iconos pasandole el Hwnd del escritorio
  99. ShowWindow Ret, SW_SHOW
  100. MsgBox "JAJAJAJA"
  101. Unload Me
  102. End Sub
  103.  


Descargar URL:
http://www.gigasize.com/get.php?d=qmqpdwynqzb

Mirror:
http://hotfile.com/dl/73058161/c66defd/PSEUDO_ESCRITORIO.rar.html


P.D: Me voy, suerte, hasta el lunes.

GRACIAS POR LEER!!!
117  Programación / Programación Visual Basic / [Juego] Carreras de caballos. en: 1 Octubre 2010, 16:37 pm
HOLA!!!

Esta vez es un juego de carreras de caballos con apuestas.
Este es mas "lindo" que el anterior. ;-) ;-)

Descargar URL:
http://www.gigasize.com/get.php?d=57lg24wr36d

Mirror:
http://hotfile.com/dl/73029647/0afa14a/Juego_de_caballos.rar.html



P.D: Se puede cambiar las apuestas en el medio de la carrera. En su momento no me di cuenta pero fue XD. Corrijan el codigo si quieren y listo.



GRACIAS POR LEER!!!
118  Programación / Programación Visual Basic / [Juego] Juego muy adictivo que arme, les juro que es divertido. en: 29 Septiembre 2010, 13:50 pm
HOLA!!!

Les dejo este jueguito, esta muy bueno , pero es precario. Igual es muy adictivo.
El que lo gane en imposible sin hacer trampa que avise XD ni yo lo gane ;P.

Descargar URL:
http://www.gigasize.com/get.php?d=29cfyvy3hfd

Mirror:
http://hotfile.com/dl/72555975/0a3baa1/Jueguito_de_clickear_el_Punto_Rojo.rar.html

GRACIAS POR LEER!!!
119  Programación / Programación Visual Basic / [Mini Aporte] BASICO Codigo para Cambiar Proxies del iexplore en: 29 Septiembre 2010, 13:38 pm
HOLA!!!

Bueno, aca abajo esta como cambiar los proxies del iexplore por el registro.
Solamente tenes que cargar el Vector "Proxy()" y enviar la variable "NumProx" que vendria a ser el numero de proxy en la lista.

Use este codigo en un programa que servia para hacer clicks automaticos en google cada un intervalo aleatorio de segundos para subir el G.Analytics. (o como se escriba).

No es un codigo grande, pero me ayudo en su momento, por ahi les puede servir. Igual, obvio que este post no va dedicado a un nivel alto.

Pero si quieren que corrija algo avisen.


Código
  1. Public NumProx as integer
  2.  
  3. Private Sub Form_Unload(Cancel As Integer)
  4. Dim strProxyServer
  5. ' define el proxy y el puerto si es necesario
  6. strProxyServer = ""
  7. ' ubicacion en la registry
  8. Dim strRegPath
  9. strRegPath = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
  10. Set oWshShell = CreateObject("WScript.Shell")
  11. ' modifica las entradas en el registro
  12. Call oWshShell.RegWrite(strRegPath & "ProxyEnable", "00000001", "REG_DWORD")
  13. Call oWshShell.RegWrite(strRegPath & "ProxyOverride", "<local>", "REG_SZ")
  14. Call oWshShell.RegWrite(strRegPath & "ProxyServer", strProxyServer, "REG_SZ")
  15. ' destroy
  16. Set oWshShell = Nothing
  17. End Sub
  18.  
  19. Private Sub PROXYCHANGE()
  20. Dim strProxyServer
  21. ' define el proxy y el puerto si es necesario
  22. strProxyServer = PROXY(numProx)
  23. ' ubicacion en la registry
  24. Dim strRegPath
  25. strRegPath = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
  26. Set oWshShell = CreateObject("WScript.Shell")
  27. ' modifica las entradas en el registro
  28. Call oWshShell.RegWrite(strRegPath & "ProxyEnable", "00000001", "REG_DWORD")
  29. Call oWshShell.RegWrite(strRegPath & "ProxyOverride", "<local>", "REG_SZ")
  30. Call oWshShell.RegWrite(strRegPath & "ProxyServer", strProxyServer, "REG_SZ")
  31. ' destroy
  32. Set oWshShell = Nothing
  33. End Sub
  34.  

GRACIAS POR LEER!!!
120  Programación / Programación Visual Basic / [Source] Sistema de Archivo y Busqueda Progresiva.(De gestion) en: 28 Septiembre 2010, 16:17 pm
HOLA!!!

Hola, hoy se me ocurrio publicar un sistema que sirve para un estudio contable o juridico o cualquier otro que maneje muchos papeles y los ordene en cajas o biblioratos.

Este programa lo que hace es simplemente Guardar los datos y luego filtrarlos en tiempo real mientras se escribe en el text box.

Mirenlo, seguramente diran que gasto muchos recursos, y es cierto. Pero bueno, fue uno de los primeros programas que arme.

Procedimientos usados:
Alta
Baja
Modificacion
Busqueda progresiva
Reordenamiento por burbujeo.
Resize
Print

En definitiva es eso. descarguenlo no viene mal.

LINK:

http://www.megaupload.com/?d=0613NCAC

MIRRORS:
http://www.gigasize.com/get.php?d=hlzg40wk95b
http://hotfile.com/dl/72402081/843661d/Sistema_de_Archivo.rar.html

GRACIAS POR LEER!!!
Páginas: 1 2 3 4 5 6 7 8 9 10 11 [12] 13
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines