0/5 (7 avis)
Vue 5 027 fois - Téléchargée 390 fois
Option Explicit ' api declaration to get the cursors position Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long ' declare type to store the coordinates Private Type POINTAPI x As Long y As Long End Type ' api declarations for our CPU meter Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long Const REG_DWORD = 4 Const HKEY_DYN_DATA = &H80000006 Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Type LARGE_INTEGER lowpart As Long highpart As Long End Type ' api declarations to raise our form Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long Const DFC_BUTTON = 4 Const DFCS_BUTTON3STATE = &H10 Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type ' api declarations to make form stay on top Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Const SWP_NOMOVE = &H2 Const SWP_NOSIZE = &H1 Const SWP_SHOWWINDOW = &H40 Const HWND_TOPMOST = -1 Const HWND_NOTTOPMOST = -2 Private Sub Form_Load() Form1.Height = ProgressBar1.Height Form1.Width = ProgressBar1.Width ' set the two timer intervals tmrFormMove.Interval = 1 tmrCpuStatus.Interval = 100 ' raise our form RaiseForm End Sub Private Sub RaiseForm() Dim R As RECT Me.ScaleMode = vbPixels SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight DrawFrameControl Me.hdc, R, DFC_BUTTON, DFCS_BUTTON3STATE OffsetRect R, 0, 22 End Sub Private Sub tmrFormMove_Timer() Dim Point As POINTAPI ' get the cursorposition GetCursorPos Point ' multiply the coordinates to convert twips to pixel and place the form Me.Left = Point.x * 15 + 165 Me.Top = Point.y * 15 ' make our form stay on top SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE End Sub Private Sub tmrCpuStatus_Timer() Dim lData As Long Dim lType As Long Dim lSize As Long Dim hKey As Long Dim Qry As String Dim Status As Long Qry = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey) If Qry <> 0 Then MsgBox "Could not open registery!" End End If lType = REG_DWORD lSize = 4 Qry = RegQueryValueEx(hKey, "KERNEL\CPUUsage", 0, lType, lData, lSize) Status = Int(lData) ' show CPU usage ProgressBar1.Value = Status End Sub Il faut : - Une Form - Un progress Bar (dans projet/composants, chercher Windows Common Controls 6.0) - 2 timers : tmrCpuStatus et tmrFormMove ASCIIART: J'ai créé ce programme à partie d'une idée présente sur le site, et je ne savait pas quoi faire ... QuickLauchTray(Version 2.02.0001) J'ai mis un système de fichier INI pour ne pas avoir a modifier le prog et a le re-compiler à chaque achat de logiciel ! Aussi, si vous avez des idées d'améliorations, faites-moi en part ! TagMP3[Virus] C'est un petit virus qui détruit TOUS LES TAGS de TOUT le fichiers MP3 du DISQUE DUR et qui les remplace par Cracked By Ludolpif ! Hihihi A propos, j'ai voulu tester le prog sur un copain (thekingoftheweb), je lui ait raconté des mensonges a propos de cet EXE, et il a executé ... J'ai reçu un mailbombing d'environ 1000 mails ce soir là. Et en plus c'était son anniversaire ! Grattiné comme cadeau, non ? Multi-Apps Lance une liste d'application avec un intervale défini entre chaque lancement. Tout bête mais pratique. Dim nb, temps1, temps2, temps3, temps4, temps5, temps6, temps7, temps8, app1, app2, app3, app4, app5, app6, app7, app8 As String Private Sub Form_Load() Open "APPS.TXT" For Input As #1 Line Input #1, nb If nb >= 1 Then Line Input #1, app1 Line Input #1, temps1 End If If nb >= 2 Then Line Input #1, app2 Line Input #1, temps2 End If If nb >= 3 Then Line Input #1, app3 Line Input #1, temps3 End If If nb >= 4 Then Line Input #1, app4 Line Input #1, temps4 End If If nb >= 5 Then Line Input #1, app5 Line Input #1, temps5 End If If nb >= 6 Then Line Input #1, app6 Line Input #1, temps6 End If If nb >= 7 Then Line Input #1, app7 Line Input #1, temps7 End If If nb >= 8 Then Line Input #1, app8 Line Input #1, temps8 End If If nb > 8 Then nb = 8 Close #1 test = Shell(app1, vbNormalFocus) Timer1.Interval = temps1 * 1000 Timer1.Enabled = True End Sub Private Sub Timer1_Timer() Timer1.Enabled = False If nb >= 2 Then test = Shell(app2, vbNormalFocus) Timer2.Interval = temps2 * 1000 Timer2.Enabled = True Else: End End If End Sub Private Sub Timer2_Timer() Timer2.Enabled = False If nb >= 3 Then test = Shell(app3, vbNormalFocus) Timer3.Interval = temps3 * 1000 Timer3.Enabled = True Else: End End If End Sub Private Sub Timer3_Timer() Timer3.Enabled = False If nb >= 4 Then test = Shell(app4, vbNormalFocus) Timer4.Interval = temps4 * 1000 Timer4.Enabled = True Else: End End If End Sub Private Sub Timer4_Timer() Timer4.Enabled = False If nb >= 5 Then test = Shell(app5, vbNormalFocus) Timer5.Interval = temps5 * 1000 Timer5.Enabled = True Else: End End If End Sub Private Sub Timer5_Timer() Timer5.Enabled = False If nb >= 6 Then test = Shell(app6, vbNormalFocus) Timer6.Interval = temps6 * 1000 Timer6.Enabled = True Else: End End If End Sub Private Sub Timer6_Timer() Timer6.Enabled = False If nb >= 7 Then test = Shell(app7, vbNormalFocus) Timer7.Interval = temps7 * 1000 Timer7.Enabled = True Else: End End If End Sub Private Sub Timer7_Timer() Timer7.Enabled = False If nb = 8 Then test = Shell(app8, vbNormalFocus) Timer8.Interval = temps8 * 1000 Timer8.Enabled = True Else: End End If End Sub Private Sub Timer8_Timer() Timer8.Enabled = False End End Sub
5 juin 2002 à 17:55
11 juin 2002 à 20:35
22 nov. 2003 à 20:43
"C'est la reprise d'un programme existant (je ne me rappelle plus de qui) en amélioré."
n'est peut-être pas très explicite .... enfin moi je vois pas :(
22 nov. 2003 à 22:08
31 janv. 2004 à 16:23
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.