Est-il possible d'accélérer une partie du programe?
banania72000
Messages postés
3
Date d'inscription
samedi 7 mars 2009
Statut
Membre
Dernière intervention
21 juillet 2010
-
20 juil. 2010 à 01:16
banania72000 Messages postés 3 Date d'inscription samedi 7 mars 2009 Statut Membre Dernière intervention 21 juillet 2010 - 21 juil. 2010 à 13:12
banania72000 Messages postés 3 Date d'inscription samedi 7 mars 2009 Statut Membre Dernière intervention 21 juillet 2010 - 21 juil. 2010 à 13:12
A voir également:
- Vb net const
- Javascript partie entière - Forum Java
- Python extraire une partie d'une chaine de caractère - Forum Python
- Partie entière supérieure python ✓ - Forum Flash
- Comment reprendre juste une partie d'une chaine de caractère ? - Forum ColdFusion
- Extraire une partie d'une chaine de caractères ✓ - Forum VB.NET
4 réponses
nhervagault
Messages postés
6063
Date d'inscription
dimanche 13 avril 2003
Statut
Membre
Dernière intervention
15 juillet 2011
37
20 juil. 2010 à 10:04
20 juil. 2010 à 10:04
Bonjour,
Un petit code serait mieux car sans ca c'est difficile de t'aider
Un petit code serait mieux car sans ca c'est difficile de t'aider
banania72000
Messages postés
3
Date d'inscription
samedi 7 mars 2009
Statut
Membre
Dernière intervention
21 juillet 2010
20 juil. 2010 à 12:55
20 juil. 2010 à 12:55
Public Class FrmMain
#Region " API Souris "
Private Declare Sub Mouse_Event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Integer, ByVal dx As Integer, ByVal dy As Integer, ByVal cButtons As Integer, ByVal dwExtraInfo As Integer)
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const MOUSEEVENTF_WHEEL = &H800
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Sub DoMouseEvent(ByVal Button As Integer, Optional ByVal ExtraInfo As Integer = 0)
Mouse_Event(Button, 0, 0, ExtraInfo, 1)
End Sub
#End Region
#Region " API Clavier "
Private Declare Sub Keybd_Event Lib "user32" Alias "keybd_event" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As UInteger, ByVal dwExtraInfo As UIntPtr)
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Sub DoKeyEvent(ByVal KeyCode As Integer, ByVal Up As Boolean)
Keybd_Event(KeyCode, &H45, IIf(Up, KEYEVENTF_KEYUP Or KEYEVENTF_EXTENDEDKEY, KEYEVENTF_EXTENDEDKEY), 0)
End Sub
#End Region
#Region " Déclarations "
Private m_ToMake As String = ""
Private m_LastAction As Long = 0
Private m_Listen As Boolean = False
Private m_IsWorking As Boolean = False
Private Sub Wait(ByVal Time As Long)
Dim Quota As Long = Time + Environment.TickCount
While Quota > Environment.TickCount
Threading.Thread.Sleep(1)
Application.DoEvents()
End While
End Sub
#End Region
#Region " Ajout d'events "
Private Sub AddWaitEvent()
If Not m_Listen Then Exit Sub
If m_LastAction <> 0 Then
Dim TimeWait As Long = Environment.TickCount - m_LastAction
If TimeWait > 0 Then
m_ToMake &= "W," & TimeWait & vbCrLf
End If
End If
m_LastAction = Environment.TickCount
End Sub
Private Sub AddMouseEvent(ByVal X As Integer, ByVal Y As Integer)
If Not m_Listen Then Exit Sub
AddWaitEvent()
m_ToMake &= "M," & X & "," & Y & vbCrLf
End Sub
Private Sub AddClickEvent(ByVal Up As Boolean, ByVal Button As Windows.Forms.MouseButtons)
If Not m_Listen Then Exit Sub
AddWaitEvent()
Select Case Button
Case Windows.Forms.MouseButtons.Left
If Up Then
m_ToMake &= "C," & MOUSEEVENTF_LEFTUP & vbCrLf
Else
m_ToMake &= "C," & MOUSEEVENTF_LEFTDOWN & vbCrLf
End If
Case Windows.Forms.MouseButtons.Middle
If Up Then
m_ToMake &= "C," & MOUSEEVENTF_MIDDLEUP & vbCrLf
Else
m_ToMake &= "C," & MOUSEEVENTF_MIDDLEDOWN & vbCrLf
End If
Case Windows.Forms.MouseButtons.Right
If Up Then
m_ToMake &= "C," & MOUSEEVENTF_RIGHTUP & vbCrLf
Else
m_ToMake &= "C," & MOUSEEVENTF_RIGHTDOWN & vbCrLf
End If
End Select
End Sub
Private Sub AddKeyEvent(ByVal KeyNumber As Integer, ByVal Up As Boolean)
If Not m_Listen Then Exit Sub
AddWaitEvent()
m_ToMake &= "K," & IIf(Up, "1", "0") & "," & KeyNumber & vbCrLf
End Sub
#End Region
#Region " Gestion events "
Private Sub MouseMoved(ByVal sender As System.Object, ByVal e As Windows.Forms.MouseEventArgs)
Dim Maximum As Rectangle = Screen.PrimaryScreen.Bounds
If e.X >= Maximum.Left AndAlso e.Y >= Maximum.Top AndAlso _
e.X <= Maximum.Right AndAlso e.Y <= Maximum.Bottom Then
AddMouseEvent(e.X, e.Y)
End If
End Sub
Private Sub MouseUpped(ByVal sender As System.Object, ByVal e As Windows.Forms.MouseEventArgs)
AddClickEvent(True, e.Button)
End Sub
Private Sub MouseDowned(ByVal sender As System.Object, ByVal e As Windows.Forms.MouseEventArgs)
AddClickEvent(False, e.Button)
End Sub
Private Sub MouseWheeled(ByVal sender As System.Object, ByVal e As Windows.Forms.MouseEventArgs)
AddWaitEvent()
m_ToMake &= "R," & e.Delta & vbCrLf
End Sub
Private Sub KeyPressed(ByVal sender As System.Object, ByVal e As Windows.Forms.KeyEventArgs)
Select Case e.KeyCode
Case Keys.F6
ToggleApp()
Case Keys.F7
StartWorking(1)
Case Keys.F8
StartWorking(100000)
Case Keys.F9
StartWorking(1)
Case Keys.F10
StartWorking(1)
Case Keys.F11
StartWorking(1)
Case Else
AddKeyEvent(e.KeyCode, False)
End Select
End Sub
Private Sub KeyUpped(ByVal sender As System.Object, ByVal e As Windows.Forms.KeyEventArgs)
Select Case e.KeyCode
Case Keys.F6
Case Keys.F7
Case Keys.F8
Case Keys.F9
Case Keys.F10
Case Keys.F11
Case Else
AddKeyEvent(e.KeyCode, True)
End Select
End Sub
#End Region
#Region " Apprentissage "
Private Sub StartApp()
m_ToMake = ""
m_LastAction = 0
m_Listen = True
AddHandler Gma.UserActivityMonitor.HookManager.MouseMove, AddressOf MouseMoved
AddHandler Gma.UserActivityMonitor.HookManager.MouseUp, AddressOf MouseUpped
AddHandler Gma.UserActivityMonitor.HookManager.MouseDown, AddressOf MouseDowned
AddHandler Gma.UserActivityMonitor.HookManager.MouseWheel, AddressOf MouseWheeled
End Sub
Private Sub StopApp()
m_Listen = False
RemoveHandler Gma.UserActivityMonitor.HookManager.MouseMove, AddressOf MouseMoved
RemoveHandler Gma.UserActivityMonitor.HookManager.MouseUp, AddressOf MouseUpped
RemoveHandler Gma.UserActivityMonitor.HookManager.MouseDown, AddressOf MouseDowned
RemoveHandler Gma.UserActivityMonitor.HookManager.MouseWheel, AddressOf MouseWheeled
End Sub
Private Sub ToggleApp()
If m_Listen Then
StopApp()
LearnButton.Text = "Learn (F6)"
ScriptBox.Text = m_ToMake
Else
StartApp()
LearnButton.Text = "Stop (F6)"
ScriptBox.Text = "En cours d'enregistrement..."
End If
End Sub
Private Sub conexion()
If m_Listen Then
StopApp()
Button2.Text = "connexion des comptes (F11)"
ScriptBox.Text = ""
Else
StartApp()
Button2.Text = "Stop (F6)"
ScriptBox.Text = "En cours de connexion..."
End If
End Sub
#End Region
#Region " Répétition "
Private Sub StartRepeat(ByVal Number As Integer)
m_IsWorking = True
For i As Integer = 1 To Number
If Not m_IsWorking Then Exit For
For Each Line As String In ScriptBox.Lines
If Not m_IsWorking Then Exit For
If Line <> "" Then
Dim Data() As String = Line.Split(",")
Execute(Data)
End If
Next
Next
StartWorking(0)
End Sub
Private Sub StartWorking(ByVal Number As Integer)
If Not m_IsWorking Then
RepeatButton.Text = "Stop (F7)"
RepeatButton2.Text = "Stop (F8)"
StartRepeat(Number)
Else
m_IsWorking = False
RepeatButton.Text = "Launch (F7)"
RepeatButton2.Text = "Repeat (F8)"
End If
End Sub
#End Region
#Region " Exécution "
Private Sub Execute(ByVal Data() As String)
Try
Select Case Data(0)
Case "W"
Wait(Data(1))
Case "M"
Mouse_Event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, _
CInt(Data(1)) * 65535 / Windows.Forms.Screen.PrimaryScreen.Bounds.Width, _
CInt(Data(2)) * 65535 / System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height, 0, 0)
Case "C"
DoMouseEvent(Data(1))
Case "R"
DoMouseEvent(MOUSEEVENTF_WHEEL, Data(1))
Case "K"
DoKeyEvent(Data(2), Data(1) = "1")
End Select
Catch ex As Exception
Debug.Print(ex.ToString)
End Try
End Sub
#End Region
#Region " Formulaire "
Private Sub LearnButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LearnButton.Click
ToggleApp()
End Sub
Private Sub RepeatButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RepeatButton.Click
StartWorking(1)
End Sub
Private Sub RepeatButton2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RepeatButton2.Click
StartWorking(100000)
End Sub
Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
AddHandler Gma.UserActivityMonitor.HookManager.KeyDown, AddressOf KeyPressed
AddHandler Gma.UserActivityMonitor.HookManager.KeyUp, AddressOf KeyUpped
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
StartWorking(1)
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
conexion()
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
StartWorking(1)
End Sub
#End Region
Private Sub ScriptBox_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ScriptBox.TextChanged
End Sub
End Class
#Region " API Souris "
Private Declare Sub Mouse_Event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Integer, ByVal dx As Integer, ByVal dy As Integer, ByVal cButtons As Integer, ByVal dwExtraInfo As Integer)
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const MOUSEEVENTF_WHEEL = &H800
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Sub DoMouseEvent(ByVal Button As Integer, Optional ByVal ExtraInfo As Integer = 0)
Mouse_Event(Button, 0, 0, ExtraInfo, 1)
End Sub
#End Region
#Region " API Clavier "
Private Declare Sub Keybd_Event Lib "user32" Alias "keybd_event" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As UInteger, ByVal dwExtraInfo As UIntPtr)
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Sub DoKeyEvent(ByVal KeyCode As Integer, ByVal Up As Boolean)
Keybd_Event(KeyCode, &H45, IIf(Up, KEYEVENTF_KEYUP Or KEYEVENTF_EXTENDEDKEY, KEYEVENTF_EXTENDEDKEY), 0)
End Sub
#End Region
#Region " Déclarations "
Private m_ToMake As String = ""
Private m_LastAction As Long = 0
Private m_Listen As Boolean = False
Private m_IsWorking As Boolean = False
Private Sub Wait(ByVal Time As Long)
Dim Quota As Long = Time + Environment.TickCount
While Quota > Environment.TickCount
Threading.Thread.Sleep(1)
Application.DoEvents()
End While
End Sub
#End Region
#Region " Ajout d'events "
Private Sub AddWaitEvent()
If Not m_Listen Then Exit Sub
If m_LastAction <> 0 Then
Dim TimeWait As Long = Environment.TickCount - m_LastAction
If TimeWait > 0 Then
m_ToMake &= "W," & TimeWait & vbCrLf
End If
End If
m_LastAction = Environment.TickCount
End Sub
Private Sub AddMouseEvent(ByVal X As Integer, ByVal Y As Integer)
If Not m_Listen Then Exit Sub
AddWaitEvent()
m_ToMake &= "M," & X & "," & Y & vbCrLf
End Sub
Private Sub AddClickEvent(ByVal Up As Boolean, ByVal Button As Windows.Forms.MouseButtons)
If Not m_Listen Then Exit Sub
AddWaitEvent()
Select Case Button
Case Windows.Forms.MouseButtons.Left
If Up Then
m_ToMake &= "C," & MOUSEEVENTF_LEFTUP & vbCrLf
Else
m_ToMake &= "C," & MOUSEEVENTF_LEFTDOWN & vbCrLf
End If
Case Windows.Forms.MouseButtons.Middle
If Up Then
m_ToMake &= "C," & MOUSEEVENTF_MIDDLEUP & vbCrLf
Else
m_ToMake &= "C," & MOUSEEVENTF_MIDDLEDOWN & vbCrLf
End If
Case Windows.Forms.MouseButtons.Right
If Up Then
m_ToMake &= "C," & MOUSEEVENTF_RIGHTUP & vbCrLf
Else
m_ToMake &= "C," & MOUSEEVENTF_RIGHTDOWN & vbCrLf
End If
End Select
End Sub
Private Sub AddKeyEvent(ByVal KeyNumber As Integer, ByVal Up As Boolean)
If Not m_Listen Then Exit Sub
AddWaitEvent()
m_ToMake &= "K," & IIf(Up, "1", "0") & "," & KeyNumber & vbCrLf
End Sub
#End Region
#Region " Gestion events "
Private Sub MouseMoved(ByVal sender As System.Object, ByVal e As Windows.Forms.MouseEventArgs)
Dim Maximum As Rectangle = Screen.PrimaryScreen.Bounds
If e.X >= Maximum.Left AndAlso e.Y >= Maximum.Top AndAlso _
e.X <= Maximum.Right AndAlso e.Y <= Maximum.Bottom Then
AddMouseEvent(e.X, e.Y)
End If
End Sub
Private Sub MouseUpped(ByVal sender As System.Object, ByVal e As Windows.Forms.MouseEventArgs)
AddClickEvent(True, e.Button)
End Sub
Private Sub MouseDowned(ByVal sender As System.Object, ByVal e As Windows.Forms.MouseEventArgs)
AddClickEvent(False, e.Button)
End Sub
Private Sub MouseWheeled(ByVal sender As System.Object, ByVal e As Windows.Forms.MouseEventArgs)
AddWaitEvent()
m_ToMake &= "R," & e.Delta & vbCrLf
End Sub
Private Sub KeyPressed(ByVal sender As System.Object, ByVal e As Windows.Forms.KeyEventArgs)
Select Case e.KeyCode
Case Keys.F6
ToggleApp()
Case Keys.F7
StartWorking(1)
Case Keys.F8
StartWorking(100000)
Case Keys.F9
StartWorking(1)
Case Keys.F10
StartWorking(1)
Case Keys.F11
StartWorking(1)
Case Else
AddKeyEvent(e.KeyCode, False)
End Select
End Sub
Private Sub KeyUpped(ByVal sender As System.Object, ByVal e As Windows.Forms.KeyEventArgs)
Select Case e.KeyCode
Case Keys.F6
Case Keys.F7
Case Keys.F8
Case Keys.F9
Case Keys.F10
Case Keys.F11
Case Else
AddKeyEvent(e.KeyCode, True)
End Select
End Sub
#End Region
#Region " Apprentissage "
Private Sub StartApp()
m_ToMake = ""
m_LastAction = 0
m_Listen = True
AddHandler Gma.UserActivityMonitor.HookManager.MouseMove, AddressOf MouseMoved
AddHandler Gma.UserActivityMonitor.HookManager.MouseUp, AddressOf MouseUpped
AddHandler Gma.UserActivityMonitor.HookManager.MouseDown, AddressOf MouseDowned
AddHandler Gma.UserActivityMonitor.HookManager.MouseWheel, AddressOf MouseWheeled
End Sub
Private Sub StopApp()
m_Listen = False
RemoveHandler Gma.UserActivityMonitor.HookManager.MouseMove, AddressOf MouseMoved
RemoveHandler Gma.UserActivityMonitor.HookManager.MouseUp, AddressOf MouseUpped
RemoveHandler Gma.UserActivityMonitor.HookManager.MouseDown, AddressOf MouseDowned
RemoveHandler Gma.UserActivityMonitor.HookManager.MouseWheel, AddressOf MouseWheeled
End Sub
Private Sub ToggleApp()
If m_Listen Then
StopApp()
LearnButton.Text = "Learn (F6)"
ScriptBox.Text = m_ToMake
Else
StartApp()
LearnButton.Text = "Stop (F6)"
ScriptBox.Text = "En cours d'enregistrement..."
End If
End Sub
Private Sub conexion()
If m_Listen Then
StopApp()
Button2.Text = "connexion des comptes (F11)"
ScriptBox.Text = ""
Else
StartApp()
Button2.Text = "Stop (F6)"
ScriptBox.Text = "En cours de connexion..."
End If
End Sub
#End Region
#Region " Répétition "
Private Sub StartRepeat(ByVal Number As Integer)
m_IsWorking = True
For i As Integer = 1 To Number
If Not m_IsWorking Then Exit For
For Each Line As String In ScriptBox.Lines
If Not m_IsWorking Then Exit For
If Line <> "" Then
Dim Data() As String = Line.Split(",")
Execute(Data)
End If
Next
Next
StartWorking(0)
End Sub
Private Sub StartWorking(ByVal Number As Integer)
If Not m_IsWorking Then
RepeatButton.Text = "Stop (F7)"
RepeatButton2.Text = "Stop (F8)"
StartRepeat(Number)
Else
m_IsWorking = False
RepeatButton.Text = "Launch (F7)"
RepeatButton2.Text = "Repeat (F8)"
End If
End Sub
#End Region
#Region " Exécution "
Private Sub Execute(ByVal Data() As String)
Try
Select Case Data(0)
Case "W"
Wait(Data(1))
Case "M"
Mouse_Event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, _
CInt(Data(1)) * 65535 / Windows.Forms.Screen.PrimaryScreen.Bounds.Width, _
CInt(Data(2)) * 65535 / System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height, 0, 0)
Case "C"
DoMouseEvent(Data(1))
Case "R"
DoMouseEvent(MOUSEEVENTF_WHEEL, Data(1))
Case "K"
DoKeyEvent(Data(2), Data(1) = "1")
End Select
Catch ex As Exception
Debug.Print(ex.ToString)
End Try
End Sub
#End Region
#Region " Formulaire "
Private Sub LearnButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LearnButton.Click
ToggleApp()
End Sub
Private Sub RepeatButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RepeatButton.Click
StartWorking(1)
End Sub
Private Sub RepeatButton2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RepeatButton2.Click
StartWorking(100000)
End Sub
Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
AddHandler Gma.UserActivityMonitor.HookManager.KeyDown, AddressOf KeyPressed
AddHandler Gma.UserActivityMonitor.HookManager.KeyUp, AddressOf KeyUpped
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
StartWorking(1)
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
conexion()
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
StartWorking(1)
End Sub
#End Region
Private Sub ScriptBox_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ScriptBox.TextChanged
End Sub
End Class
nhervagault
Messages postés
6063
Date d'inscription
dimanche 13 avril 2003
Statut
Membre
Dernière intervention
15 juillet 2011
37
20 juil. 2010 à 19:16
20 juil. 2010 à 19:16
Peut etre
http://www.codeproject.com/KB/cs/globalhook.aspx
http://www.codeproject.com/KB/system/globalmousekeyboardlib.aspx
ca peut t'aider.
http://www.codeproject.com/KB/cs/globalhook.aspx
http://www.codeproject.com/KB/system/globalmousekeyboardlib.aspx
ca peut t'aider.
banania72000
Messages postés
3
Date d'inscription
samedi 7 mars 2009
Statut
Membre
Dernière intervention
21 juillet 2010
21 juil. 2010 à 13:12
21 juil. 2010 à 13:12
Je vais essayer merci beaucoup de ton aide. Et bonne journée.
