Cpu (titre trop court)

Télécharger le projet
Commenter

Description

C'est la reprise d'un programme existant (je ne me rappelle plus de qui) en amélioré.

Source / Exemple : 


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

Conclusion :


Il faut :
- Une Form
- Un progress Bar (dans projet/composants, chercher Windows Common Controls 6.0)
- 2 timers : tmrCpuStatus et tmrFormMove
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (Ludolpif)