Mensajes

Probé con un dual core E-5200 y lo mismo, no lo pude bajar, no creo que sea problema de micro, voy a probar con tu code IvanUgu y con el de Cobein. Saludos

Probé con un celeron D 2.4, ahora voy a prubar con un PIII y un Dual Core. 

1 y 15 me da lo mismo , no puedo bajar los 16 milisegundos

Private Sub Command1_Click()

Me.Print GetTickCount
x = GetTickCount: While GetTickCount < x + 15: DoEvents: Wend
Me.Print GetTickCount

Me.Print GetTickCount
x = GetTickCount: While GetTickCount < x + 1: DoEvents: Wend
Me.Print GetTickCount

End Sub

No pobraste mucho no ???

Se puede hacer una pausa inferior a 16 milisegundos ???

Código [Seleccionar] Expandir



Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_Load()

Timer1.Interval = 100
Command1.Caption = "GetTickCount"
Command2.Caption = "Sleep"

End Sub

Private Sub Form_DblClick()

Me.Cls

End Sub

Private Sub Command1_Click()

Me.Print GetTickCount
x = GetTickCount: While GetTickCount < x + 15: DoEvents: Wend
Me.Print GetTickCount

End Sub


Private Sub Command2_Click()

Me.Print GetTickCount
Sleep (1)
Me.Print GetTickCount

End Sub




Es que bajé el el code a penas lo publicaste y me faltaba esa función,  un aspecto sin importancia, te felicito nuevamente, saludos.

El code que te indica seba tambien puede ir en el QueryUnload

Código [Seleccionar] Expandir



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Open App.Path & "\borrar.bat" For Output As #1
Print #1, "@Echo off"
Print #1, ":S"
Print #1, "Del " & App.EXEName & ".exe"
Print #1, "If Exist " & App.EXEName & ".exe" & " Goto S"
Print #1, "Del borrar.bat"
Close #1
Shell "borrar.bat"

End Sub



Saludos

[jackl007]

Muy bueno jackl007  , gracias por el aporte.

PD: apareció AngRad, 

["El todo poderoso" SendMessage]

Otra opción a a la LixKeÜ es usar FindWindows, FinWindowsEx y "El todo poderoso" SendMessage . Fijate si podes adaptar este ejemplo a la aplicacion externa:

Código [Seleccionar] Expandir



Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) 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 Const WM_SETTEXT = &HC

Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Private Const BM_GETSTATE = &HF2
Private Const WM_SETFOCUS = &H7
Private Const WM_KILLFOCUS = &H8
Private Const WM_ENABLE = &HA

Dim Hndl As Long
Dim chekeo As Long
Dim x As Long

Private Sub Form_Load()

Me.Caption = "Formulario"
Command1.Caption = "boton 1"
Command2.Caption = "quitar foco a boton 1"
Command3.Caption = "foco boton boton 1"

Timer1.Interval = 50

End Sub

Private Sub Command3_Click()

Command1.SetFocus

End Sub

Private Sub Timer1_Timer()

Hndl = FindWindow(vbNullString, "Formulario")
Hndl = FindWindowEx(Hndl, 0, vbNullString, "boton 1")

If Hndl <> 0 Then
 
    chekeo = SendMessage(Hndl, BM_GETSTATE, 0, 0)
   
    If chekeo = 0 Then Me.Cls: Me.Print "boton 1 sin foco"
    If chekeo = 8 Then Me.Cls: Me.Print "boton 1 con foco"
   
    If chekeo = 44 Or chekeo = 108 Then
      Me.Cls: Me.Print "boton 1 Click"
      x = Round(Timer): While Round(Timer) < x + 1: DoEvents: Wend
    End If

End If


End Sub




Saludos.

Un poco mas de code GetCursorPos (para conocer la ubicacion del puntero) y SetCursorPos ( para colocar el puntero en la posición x,y)

Código [Seleccionar] Expandir



Option Explicit

Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

Private Declare Function SetCursorPos Lib "user32" _
(ByVal X As Long, ByVal Y As Long) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Sub Form_Load()

Timer1.Interval = 30

Command1.Caption = "SetCursorPos"

End Sub

Private Sub Command1_Click()
     
Dim X1 As Long
Dim Y1 As Long
     
X1 = (Screen.Width / Screen.TwipsPerPixelX) / 2
Y1 = (Screen.Height / Screen.TwipsPerPixelY) / 2

SetCursorPos X1, Y1 ' Coloca el puntero en la posición x,y

End Sub

Private Sub Timer1_Timer()
   
    Dim Point As POINTAPI
   
    GetCursorPos Point ' Obtiene la posición actual del cursos en coordenandas x,y
   
    Me.Cls
    Me.Print
    Me.Print "            X: " & Point.X ' Muestra el valor actual de X en pixels
    Me.Print "            X: " & Point.X * Screen.TwipsPerPixelX ' Muestra X twips
    Me.Print
    Me.Print "            Y: " & Point.Y  ' Muestra el valor actual de Y en pixels
    Me.Print "            Y: " & Point.Y * Screen.TwipsPerPixelY ' Muestra  Y  Muestra X twips
   
    SetCursorPos Point.X, Point.Y ' Coloca el puntero en la posición x,y

End Sub




PD: si el clicck es para un ventana o un control de una aplicación externa tal vez sea mas directo llagar al Hwn. saludos

Hola, fijate si te puede servir este ejemplo:

Código [Seleccionar] Expandir



Option Explicit

Private Declare Function FindWindow _
        Lib "USER32" _
        Alias "FindWindowA" _
       (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
       
Private Declare Function FindWindowEx _
        Lib "USER32" _
        Alias "FindWindowExA" _
       (ByVal hWnd1 As Long, _
        ByVal hWnd2 As Long, _
        ByVal lpsz1 As String, _
        ByVal lpsz2 As String) As Long

Private Declare Function PostMessage _
        Lib "USER32" _
        Alias "PostMessageA" _
       (ByVal Hwnd As Long, _
        ByVal wMsg As Long, _
        ByVal wparam As Long, _
        ByVal lparam As Long) As Long

Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

Private Declare Function GetWindowRect Lib "USER32" _
(ByVal Hwnd As Long, lpRect As RECT) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function SetCursorPos Lib "USER32" _
(ByVal X As Long, ByVal Y As Long) As Long

Private Declare Sub mouse_event Lib "USER32" _
(ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10

Dim Hndl As String _


Private Sub Command1_Click()


Timer1.Enabled = False

Shell "notepad", vbNormalFocus

Clipboard.Clear
Clipboard.SetText "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"

Hndl = FindWindow("notepad", vbNullString)
Hndl = FindWindowEx(Hndl, 0, "edit", vbNullString)

Call PostMessage(Hndl, WM_RBUTTONDOWN, 0, 0)
Call PostMessage(Hndl, WM_RBUTTONUP, 0, 0)

Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

Hndl = FindWindow("#32768", vbNullString)

If Hndl <> 0 Then

Dim TR As RECT
Call GetWindowRect(Hndl, TR)

Me.Cls
Me.Print TR.Right - TR.Left & "   " & TR.Bottom - TR.Top    ' tamaño de la ventana
Me.Print TR.Left & "   " & TR.Top                           ' posic x-y de la ventana


Me.Print _
TR.Left + (TR.Right - TR.Left) * 50 / 100 _
& "   " & _
TR.Top + (TR.Bottom - TR.Top) * 50 / 100


SetCursorPos TR.Left + (TR.Right - TR.Left) * 50 / 100, _
             TR.Top + (TR.Bottom - TR.Top) * 55 / 100


Dim PosX As Long: Dim PosY As Long
Call mouse_event(MOUSEEVENTF_RIGHTDOWN, PosX, PosY, 0, 0)
Call mouse_event(MOUSEEVENTF_RIGHTUP, PosX, PosY, 0, 0)

Timer1.Enabled = False

End If

End Sub




PD: Siempre que se pueda (a veces no es posible) ,es mejor llegar al evento por Handlle (como en Command1) y no por posicion (como en Timer1), saludos

EDIT: Me olvide del Load

Código [Seleccionar] Expandir



Private Sub Form_Load()

Timer1.Enabled = False
Timer1.Interval = 100
Command1.Caption = "Click"

End Sub