Soyez le premier à donner votre avis sur cette source.
Vue 4 014 fois - Téléchargée 430 fois
' IL FAUT : - UN TIMER : timer1 - UNE IMAGE : image1 contenant une icône, pour le systray (voir ZIP) - UN MENU : Menu avec 2 éléments soujascents: MnuElement1 et MnuElement2 Option Explicit Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long Private Type IconeTray cbSize As Long 'Taille de l'icône (en octets) hWnd As Long 'Handle de la fenêtre chargée de recevoir les messages envoyés lors des évènements sur l'icône (clics, doubles-clics...) uID As Long 'Identificateur de l'icône uFlags As Long uCallbackMessage As Long 'Messages à renvoyer hIcon As Long 'Handle de l'icône szTip As String * 64 'Texte à mettre dans la bulle d'aide End Type Dim IconeT As IconeTray 'Constantes nécessaires Private Const AJOUT = &H0 Private Const MODIF = &H1 Private Const SUPPRIME = &H2 Private Const MOUSEMOVE = &H200 Private Const MESSAGE = &H1 Private Const Icone = &H2 Private Const TIP = &H4 Private Const DOUBLE_CLICK_GAUCHE = &H203 Private Const BOUTON_DROIT_LEVE = &H205 'API's nécessaire Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As IconeTray) As Boolean Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Dim Connected As Long, ConnectTime As Long, TotalConnectTime As Long Dim RAZAuto As Boolean, RAZDay As Long, RAZConfirm As Boolean Dim OldState As Long, StateChanged As Boolean Dim BeginConnect As Long, EndConnect As Long Private Sub Form_Load() 'Préparation de la variable IconeT IconeT.cbSize = Len(IconeT) 'Taille de l'icône en octet IconeT.hWnd = Me.hWnd 'Handle de l'application (pour qu'elle reçoive les messages envoyés lors d'un clic, double-clic... IconeT.uID = 1& 'Identificateur de l'icône IconeT.uFlags = Icone Or TIP Or MESSAGE IconeT.uCallbackMessage = MOUSEMOVE 'Renvoyer les messages concernant l'action de la souris IconeT.hIcon = Image1.Picture 'Mettre en icône l'image qui est dans le contrôle "Image1" IconeT.szTip = "Contrôleur de temps passé sur Internet" & Chr$(0) 'Texte de la bulle d'aide 'Appel de la fonction pour mettre l'icône dans le système tray Shell_NotifyIcon AJOUT, IconeT Me.Hide On Error Resume Next Open App.Path & "\Time.dat" For Input As #1 Input #1, TotalConnectTime Close 1 On Error GoTo 0 RAZAuto = False RAZDay = 1 RAZConfirm = False On Error Resume Next Open App.Path & "Options.dat" For Input As #2 Input #2, RAZAuto, RAZDay, RAZConfirm Close 2 On Error GoTo 0 If RAZDay = Day(Date) Then If RAZConfirm = True Then RAZConfirm = MsgBox("Voulez-vous remettre à zéro le compteur ?", vbOKCancel & vbQuestion, "Voulez vous ?") End If If RAZConfirm = True Then Open App.Path & "\Time.dat" For Output As #1 Write #1, 0 Close 1 End If End If End Sub Private Sub Timer1_Timer() Connected = InternetGetConnectedStateEx(Connected, 0, 0, 0) Select Case OldState Case 0 If Connected = 1 Then OldState = 1 StateChanged = True Else: StateChanged = False End If Case 1 If Connected = 0 Then OldState = 0 StateChanged = True Else: StateChanged = False End If End Select If StateChanged = True Then If Connected = 1 Then BeginConnect = Timer Else EndConnect = Timer On Error Resume Next Open App.Path & "Time.dat" For Input As #1 Input #1, TotalConnectTime Close 1 On Error GoTo 0 If BeginConnect < EndConnect Then ConnectTime = EndConnect - BeginConnect Else ConnectTime = (86400 - BeginConnect) + EndConnect End If Open App.Path & "\Time.dat" For Output As #1 Write #1, TotalConnectTime + ConnectTime Close 1 End If End If Select Case Connected Case 1 IconeT.szTip = "Connecté au NET" & Chr(0) 'Texte de la bulle d'aide Case 0 IconeT.szTip = "PAS Connecté au NET" & Chr(0) 'Texte de la bulle d'aide End Select Shell_NotifyIcon MODIF, IconeT End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Static rec As Boolean, msg As Long msg = X / Screen.TwipsPerPixelX If rec = False Then rec = True Select Case msg Case DOUBLE_CLICK_GAUCHE Dim ConnectTimeHours As String, TotalConnectTimeHours As String ConnectTimeHours = Int(ConnectTime / 3600) & ":" & Int(ConnectTime / 60) - Int(ConnectTime / 3600) * 3600 & ":" & ConnectTime - Int(ConnectTime / 60) * 60 TotalConnectTimeHours = Int(TotalConnectTime / 3600) & ":" & Int(TotalConnectTime / 60) - Int(TotalConnectTime / 3600) * 60 & ":" & TotalConnectTime - Int(TotalConnectTime / 60) * 60 Select Case Connected Case 0 Call MsgBox("Temps passé sur Internet à la dernière connexion : " & ConnectTimeHours & vbLf & "Temps Total passé ce mois-ci : " & TotalConnectTimeHours, vbOKOnly, "PAS Connecté au NET") Case 1 Call MsgBox("Temps passé sur Internet à la cette connexion :" & ConnectTimeHours & vbLf & "Temps Total passé ce mois-ci : " & TotalConnectTimeHours, vbOKOnly, "Connecté au NET") End Select Case BOUTON_DROIT_LEVE PopupMenu Menu End Select rec = False End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) IconeT.cbSize = Len(IconeT) IconeT.hWnd = Me.hWnd IconeT.uID = 1& Shell_NotifyIcon SUPPRIME, IconeT End Sub Private Sub MnuElement1_Click() FrmOptions.Show End Sub Private Sub MnuElement2_Click() frmAbout.Show End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.