Vbs--Questionner le taux d'utilisation du processeur pour lancer une application
alpia1234
Messages postés
1
Date d'inscription
lundi 9 mai 2005
Statut
Membre
Dernière intervention
25 mai 2005
-
25 mai 2005 à 09:58
Bubar92Bubar92 Messages postés 51 Date d'inscription mercredi 24 novembre 2004 Statut Membre Dernière intervention 23 août 2005 - 25 mai 2005 à 12:47
Bubar92Bubar92 Messages postés 51 Date d'inscription mercredi 24 novembre 2004 Statut Membre Dernière intervention 23 août 2005 - 25 mai 2005 à 12:47
A voir également:
- Vbs--Questionner le taux d'utilisation du processeur pour lancer une application
- Application pour rendez-vous - Forum VB.NET
- Lancer intranet d'entreprise - Forum PHP
- Comment créer une application android - Forum VB.NET
- Msgbox vbs - Conseils pratiques -Visual Basic / VB.NET
- Gestionnaire pour salles de sport avec application - Forum VB.NET
3 réponses
Bubar92Bubar92
Messages postés
51
Date d'inscription
mercredi 24 novembre 2004
Statut
Membre
Dernière intervention
23 août 2005
25 mai 2005 à 12:36
25 mai 2005 à 12:36
salut
a metre dans un module
Option Explicit
Private Const ClassName As String = "CPULoad"
Private Const Err_Initialize As Long = vbObjectError + 8001
Private Const Err_UnableToStartPerfmon As Long = vbObjectError + 8002
Private Const Err_CPUIndexOOB As Long = vbObjectError + 8003
Private Const Err_CantFindProcessorPerfMon As Long = vbObjectError + 8004
Private Const Err_CantFindCPUUsagePerfMon As Long = vbObjectError + 8005
Private Const Err_UnableToReadPDB As Long = vbObjectError + 8006
Private Declare Sub Memcopy Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SystemTime, lpFileTime As Currency) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
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 Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Const HKEY_DYN_DATA = &H80000006
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const REG_DWORD = 4
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_MORE_DATA = 234
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SystemTime
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Type PERF_INSTANCE_DEFINITION
ByteLength As Long
ParentObjectTitleIndex As Long
ParentObjectInstance As Long
UniqueID As Long
NameOffset As Long
NameLength As Long
End Type
Private Type PERF_COUNTER_BLOCK
ByteLength As Long
End Type
Private Type PERF_DATA_BLOCK
Signature As String * 4
LittleEndian As Long
Version As Long
Revision As Long
TotalByteLength As Long
HeaderLength As Long
NumObjectTypes As Long
DefaultObject As Long
SystemTime As SystemTime
PerfTime As LARGE_INTEGER
PerfFreq As LARGE_INTEGER
PerTime100nSec As LARGE_INTEGER
SystemNameLength As Long
SystemNameOffset As Long
End Type
Private Type PERF_OBJECT_TYPE
TotalByteLength As Long
DefinitionLength As Long
HeaderLength As Long
ObjectNameTitleIndex As Long
ObjectNameTitle As Long
ObjectHelpTitleIndex As Long
ObjectHelpTitle As Long
DetailLevel As Long
NumCounters As Long
DefaultCounter As Long
NumInstances As Long
CodePage As Long
PerfTime As LARGE_INTEGER
PerfFreq As LARGE_INTEGER
End Type
Private Type PERF_COUNTER_DEFINITION
ByteLength As Long
CounterNameTitleIndex As Long
CounterNameTitle As Long
CounterHelpTitleIndex As Long
CounterHelpTitle As Long
DefaultScale As Long
DetailLevel As Long
CounterType As Long
CounterSize As Long
CounterOffset As Long
End Type
Private Const Processor_IDX_Str As String = "238"
Private Const Processor_IDX As Long = 238
Private Const CPUUsageIDX As Long = 6
Private m_lProcessorsCount As Long
Private m_lBufferSize As Long
Private m_bIsWinNT As Boolean
Private m_bW9xCollecting As Boolean
Private m_lW9xCpuUsage As Long
Private m_hW9xCpuKey As Long
Private PDB As PERF_DATA_BLOCK
Private POT As PERF_OBJECT_TYPE
Private PCD As PERF_COUNTER_DEFINITION
Private PID As PERF_INSTANCE_DEFINITION
Private PCB As PERF_COUNTER_BLOCK
Private VI As OSVERSIONINFO
Private SysTime As Currency
Private PrevSysTime As Currency
Private m_aCounters() As Currency
Private m_aPrevCounters() As Currency
Private Const ByteIncrement As Long = 4096
Private Sub Class_Initialize()
VI.dwOSVersionInfoSize = Len(VI)
If GetVersionEx(VI) = 0 Then
Err.Raise Err_Initialize, ClassName & ".Initialize", "Impossible d'obtenir la version de Windows"
End If
m_bIsWinNT (VI.dwPlatformId VER_PLATFORM_WIN32_NT)
m_lProcessorsCount = -1
m_lBufferSize = ByteIncrement
End Sub
Private Sub Class_Terminate()
ReleaseCPUData
End Sub
Public Function CollectCPUData() As Boolean
Dim H As Long, R As Long
Dim aBuf() As Byte, lAllocSz As Long
Dim lSrc As Long, lDest As Long
Dim ptrPOT As Long, ptrPCB As Long
Dim i As Long, lCPU As Long
Dim ST As Currency
Dim sInstanceName As String
If m_bIsWinNT = True Then
lAllocSz = m_lBufferSize
ReDim aBuf(1 To lAllocSz) As Byte
While RegQueryValueEx(HKEY_PERFORMANCE_DATA, Processor_IDX_Str, _
0&, 0&, aBuf(1), m_lBufferSize) = ERROR_MORE_DATA
lAllocSz = lAllocSz + ByteIncrement
ReDim aBuf(1 To lAllocSz) As Byte
m_lBufferSize = lAllocSz
Wend
lDest = VarPtr(PDB)
lSrc = VarPtr(aBuf(1))
Memcopy ByVal lDest, ByVal lSrc, LenB(PDB)
m_lBufferSize = lAllocSz
If PDB.Signature <> "PERF" Then
Err.Raise Err_UnableToReadPDB, ClassName & ".CollectCPUData()", "Unable to read performance data"
End If
lDest = VarPtr(POT)
lSrc = VarPtr(aBuf(1)) + PDB.HeaderLength
For i = 1 To PDB.NumObjectTypes
Memcopy ByVal lDest, ByVal lSrc, LenB(POT)
ptrPOT = lSrc
If POT.ObjectNameTitleIndex = Processor_IDX Then Exit For
lSrc = lSrc + POT.TotalByteLength
Next i
If POT.ObjectNameTitleIndex <> Processor_IDX Then
Err.Raise Err_CantFindProcessorPerfMon, ClassName & ".CollectData", "Unable to locate the 'Processor' performance object"
End If
If m_lProcessorsCount < 1 Then
m_lProcessorsCount = GetCPUCount()
End If
lDest = VarPtr(PCD)
lSrc = lSrc + POT.HeaderLength
For i = 1 To POT.NumCounters
Memcopy ByVal lDest, ByVal lSrc, LenB(PCD)
If PCD.CounterNameTitleIndex = CPUUsageIDX Then Exit For
lSrc = lSrc + PCD.ByteLength
Next i
If PCD.CounterNameTitleIndex <> CPUUsageIDX Then
Err.Raise Err_CantFindCPUUsagePerfMon, ClassName & ".CollectData", "Unable to locate the '% of CPU usage' performance counter"
End If
lSrc = ptrPOT + POT.DefinitionLength
For i = 1 To POT.NumInstances
lDest = VarPtr(PID)
Memcopy ByVal lDest, ByVal lSrc, LenB(PID)
sInstanceName = Space(PID.NameLength - 2)
Memcopy ByVal sInstanceName, ByVal lSrc + PID.NameOffset, PID.NameLength - 2
sInstanceName = StrConv(sInstanceName, vbFromUnicode)
lSrc = lSrc + PID.ByteLength
lDest = VarPtr(PCB)
Memcopy ByVal lDest, ByVal lSrc, LenB(PCB)
ptrPCB = lSrc
If IsNumeric(sInstanceName) Then
lCPU = CLng(sInstanceName)
m_aPrevCounters(lCPU) = m_aCounters(lCPU)
Memcopy ByVal VarPtr(m_aCounters(lCPU)), ByVal ptrPCB + PCD.CounterOffset, LenB(m_aCounters(lCPU))
End If
lSrc = lSrc + PCB.ByteLength
Next i
PrevSysTime = SysTime
SystemTimeToFileTime PDB.SystemTime, ST
SysTime = ST
Else
If Not m_bW9xCollecting Then
R = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StartStat", 0&, KEY_ALL_ACCESS, H)
If R <> ERROR_SUCCESS Then
Err.Raise Err_UnableToStartPerfmon, ClassName & ".CollectCPRData()", "Unable to start performance monitoring"
End If
Call RegQueryValueEx(H, "KERNEL\CPUUsage", 0&, REG_DWORD, m_lW9xCpuUsage, LenB(m_lW9xCpuUsage))
Call RegCloseKey(H)
R = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0&, KEY_READ, m_hW9xCpuKey)
If R <> ERROR_SUCCESS Then
Err.Raise Err_UnableToReadPDB, ClassName & ".CollectCPUData()", "Unable to read performance data"
End If
m_bW9xCollecting = True
End If
Call RegQueryValueEx(m_hW9xCpuKey, "KERNEL\CPUUsage", 0&, REG_DWORD, m_lW9xCpuUsage, LenB(m_lW9xCpuUsage))
End If
End Function
Public Function GetCPUCount() As Long
Dim SI As SYSTEM_INFO
If m_lProcessorsCount < 1 Then
GetSystemInfo SI
GetCPUCount = SI.dwNumberOrfProcessors
m_lProcessorsCount = SI.dwNumberOrfProcessors
ReDim m_aPrevCounters(0 To m_lProcessorsCount - 1) As Currency
ReDim m_aCounters(0 To m_lProcessorsCount - 1) As Currency
Else
GetCPUCount = m_lProcessorsCount
End If
End Function
Public Function GetCPUUsage(Optional ByVal CPU_Index As Long = 1) As Long
CPU_Index = CPU_Index - 1
If m_bIsWinNT Then
If m_lProcessorsCount < 0 Then CollectCPUData
If (CPU_Index >= m_lProcessorsCount) Or (CPU_Index < 0) Then
Err.Raise Err_CPUIndexOOB, ClassName & ".GetCPUUsage()", "CPU index out of bounds"
End If
If PrevSysTime = SysTime Then
GetCPUUsage = 0
Else
GetCPUUsage = CLng(100 * (1 - (m_aCounters(CPU_Index) - m_aPrevCounters(CPU_Index)) / (SysTime - PrevSysTime)))
End If
Else
If CPU_Index <> 0 Then
Err.Raise Err_CPUIndexOOB, ClassName & ".GetCPUUsage()", "CPU index out of bounds"
End If
If Not m_bW9xCollecting Then CollectCPUData
GetCPUUsage = m_lW9xCpuUsage
End If
End Function
Private Sub ReleaseCPUData()
Dim H As Long
Dim R As Long
If m_bIsWinNT Then Exit Sub
If Not m_bW9xCollecting Then Exit Sub
m_bW9xCollecting = False
Call RegCloseKey(m_hW9xCpuKey)
m_hW9xCpuKey = 0
R = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StopStat", 0, KEY_ALL_ACCESS, H)
If R <> ERROR_SUCCESS Then Exit Sub
Call RegQueryValueEx(H, "KERNEL\CPUUsage", 0&, REG_DWORD, m_lW9xCpuUsage, LenB(m_lW9xCpuUsage))
Call RegCloseKey(H)
End Sub
a metre dans un module
Option Explicit
Private Const ClassName As String = "CPULoad"
Private Const Err_Initialize As Long = vbObjectError + 8001
Private Const Err_UnableToStartPerfmon As Long = vbObjectError + 8002
Private Const Err_CPUIndexOOB As Long = vbObjectError + 8003
Private Const Err_CantFindProcessorPerfMon As Long = vbObjectError + 8004
Private Const Err_CantFindCPUUsagePerfMon As Long = vbObjectError + 8005
Private Const Err_UnableToReadPDB As Long = vbObjectError + 8006
Private Declare Sub Memcopy Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SystemTime, lpFileTime As Currency) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
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 Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Const HKEY_DYN_DATA = &H80000006
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const REG_DWORD = 4
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_MORE_DATA = 234
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SystemTime
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Type PERF_INSTANCE_DEFINITION
ByteLength As Long
ParentObjectTitleIndex As Long
ParentObjectInstance As Long
UniqueID As Long
NameOffset As Long
NameLength As Long
End Type
Private Type PERF_COUNTER_BLOCK
ByteLength As Long
End Type
Private Type PERF_DATA_BLOCK
Signature As String * 4
LittleEndian As Long
Version As Long
Revision As Long
TotalByteLength As Long
HeaderLength As Long
NumObjectTypes As Long
DefaultObject As Long
SystemTime As SystemTime
PerfTime As LARGE_INTEGER
PerfFreq As LARGE_INTEGER
PerTime100nSec As LARGE_INTEGER
SystemNameLength As Long
SystemNameOffset As Long
End Type
Private Type PERF_OBJECT_TYPE
TotalByteLength As Long
DefinitionLength As Long
HeaderLength As Long
ObjectNameTitleIndex As Long
ObjectNameTitle As Long
ObjectHelpTitleIndex As Long
ObjectHelpTitle As Long
DetailLevel As Long
NumCounters As Long
DefaultCounter As Long
NumInstances As Long
CodePage As Long
PerfTime As LARGE_INTEGER
PerfFreq As LARGE_INTEGER
End Type
Private Type PERF_COUNTER_DEFINITION
ByteLength As Long
CounterNameTitleIndex As Long
CounterNameTitle As Long
CounterHelpTitleIndex As Long
CounterHelpTitle As Long
DefaultScale As Long
DetailLevel As Long
CounterType As Long
CounterSize As Long
CounterOffset As Long
End Type
Private Const Processor_IDX_Str As String = "238"
Private Const Processor_IDX As Long = 238
Private Const CPUUsageIDX As Long = 6
Private m_lProcessorsCount As Long
Private m_lBufferSize As Long
Private m_bIsWinNT As Boolean
Private m_bW9xCollecting As Boolean
Private m_lW9xCpuUsage As Long
Private m_hW9xCpuKey As Long
Private PDB As PERF_DATA_BLOCK
Private POT As PERF_OBJECT_TYPE
Private PCD As PERF_COUNTER_DEFINITION
Private PID As PERF_INSTANCE_DEFINITION
Private PCB As PERF_COUNTER_BLOCK
Private VI As OSVERSIONINFO
Private SysTime As Currency
Private PrevSysTime As Currency
Private m_aCounters() As Currency
Private m_aPrevCounters() As Currency
Private Const ByteIncrement As Long = 4096
Private Sub Class_Initialize()
VI.dwOSVersionInfoSize = Len(VI)
If GetVersionEx(VI) = 0 Then
Err.Raise Err_Initialize, ClassName & ".Initialize", "Impossible d'obtenir la version de Windows"
End If
m_bIsWinNT (VI.dwPlatformId VER_PLATFORM_WIN32_NT)
m_lProcessorsCount = -1
m_lBufferSize = ByteIncrement
End Sub
Private Sub Class_Terminate()
ReleaseCPUData
End Sub
Public Function CollectCPUData() As Boolean
Dim H As Long, R As Long
Dim aBuf() As Byte, lAllocSz As Long
Dim lSrc As Long, lDest As Long
Dim ptrPOT As Long, ptrPCB As Long
Dim i As Long, lCPU As Long
Dim ST As Currency
Dim sInstanceName As String
If m_bIsWinNT = True Then
lAllocSz = m_lBufferSize
ReDim aBuf(1 To lAllocSz) As Byte
While RegQueryValueEx(HKEY_PERFORMANCE_DATA, Processor_IDX_Str, _
0&, 0&, aBuf(1), m_lBufferSize) = ERROR_MORE_DATA
lAllocSz = lAllocSz + ByteIncrement
ReDim aBuf(1 To lAllocSz) As Byte
m_lBufferSize = lAllocSz
Wend
lDest = VarPtr(PDB)
lSrc = VarPtr(aBuf(1))
Memcopy ByVal lDest, ByVal lSrc, LenB(PDB)
m_lBufferSize = lAllocSz
If PDB.Signature <> "PERF" Then
Err.Raise Err_UnableToReadPDB, ClassName & ".CollectCPUData()", "Unable to read performance data"
End If
lDest = VarPtr(POT)
lSrc = VarPtr(aBuf(1)) + PDB.HeaderLength
For i = 1 To PDB.NumObjectTypes
Memcopy ByVal lDest, ByVal lSrc, LenB(POT)
ptrPOT = lSrc
If POT.ObjectNameTitleIndex = Processor_IDX Then Exit For
lSrc = lSrc + POT.TotalByteLength
Next i
If POT.ObjectNameTitleIndex <> Processor_IDX Then
Err.Raise Err_CantFindProcessorPerfMon, ClassName & ".CollectData", "Unable to locate the 'Processor' performance object"
End If
If m_lProcessorsCount < 1 Then
m_lProcessorsCount = GetCPUCount()
End If
lDest = VarPtr(PCD)
lSrc = lSrc + POT.HeaderLength
For i = 1 To POT.NumCounters
Memcopy ByVal lDest, ByVal lSrc, LenB(PCD)
If PCD.CounterNameTitleIndex = CPUUsageIDX Then Exit For
lSrc = lSrc + PCD.ByteLength
Next i
If PCD.CounterNameTitleIndex <> CPUUsageIDX Then
Err.Raise Err_CantFindCPUUsagePerfMon, ClassName & ".CollectData", "Unable to locate the '% of CPU usage' performance counter"
End If
lSrc = ptrPOT + POT.DefinitionLength
For i = 1 To POT.NumInstances
lDest = VarPtr(PID)
Memcopy ByVal lDest, ByVal lSrc, LenB(PID)
sInstanceName = Space(PID.NameLength - 2)
Memcopy ByVal sInstanceName, ByVal lSrc + PID.NameOffset, PID.NameLength - 2
sInstanceName = StrConv(sInstanceName, vbFromUnicode)
lSrc = lSrc + PID.ByteLength
lDest = VarPtr(PCB)
Memcopy ByVal lDest, ByVal lSrc, LenB(PCB)
ptrPCB = lSrc
If IsNumeric(sInstanceName) Then
lCPU = CLng(sInstanceName)
m_aPrevCounters(lCPU) = m_aCounters(lCPU)
Memcopy ByVal VarPtr(m_aCounters(lCPU)), ByVal ptrPCB + PCD.CounterOffset, LenB(m_aCounters(lCPU))
End If
lSrc = lSrc + PCB.ByteLength
Next i
PrevSysTime = SysTime
SystemTimeToFileTime PDB.SystemTime, ST
SysTime = ST
Else
If Not m_bW9xCollecting Then
R = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StartStat", 0&, KEY_ALL_ACCESS, H)
If R <> ERROR_SUCCESS Then
Err.Raise Err_UnableToStartPerfmon, ClassName & ".CollectCPRData()", "Unable to start performance monitoring"
End If
Call RegQueryValueEx(H, "KERNEL\CPUUsage", 0&, REG_DWORD, m_lW9xCpuUsage, LenB(m_lW9xCpuUsage))
Call RegCloseKey(H)
R = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0&, KEY_READ, m_hW9xCpuKey)
If R <> ERROR_SUCCESS Then
Err.Raise Err_UnableToReadPDB, ClassName & ".CollectCPUData()", "Unable to read performance data"
End If
m_bW9xCollecting = True
End If
Call RegQueryValueEx(m_hW9xCpuKey, "KERNEL\CPUUsage", 0&, REG_DWORD, m_lW9xCpuUsage, LenB(m_lW9xCpuUsage))
End If
End Function
Public Function GetCPUCount() As Long
Dim SI As SYSTEM_INFO
If m_lProcessorsCount < 1 Then
GetSystemInfo SI
GetCPUCount = SI.dwNumberOrfProcessors
m_lProcessorsCount = SI.dwNumberOrfProcessors
ReDim m_aPrevCounters(0 To m_lProcessorsCount - 1) As Currency
ReDim m_aCounters(0 To m_lProcessorsCount - 1) As Currency
Else
GetCPUCount = m_lProcessorsCount
End If
End Function
Public Function GetCPUUsage(Optional ByVal CPU_Index As Long = 1) As Long
CPU_Index = CPU_Index - 1
If m_bIsWinNT Then
If m_lProcessorsCount < 0 Then CollectCPUData
If (CPU_Index >= m_lProcessorsCount) Or (CPU_Index < 0) Then
Err.Raise Err_CPUIndexOOB, ClassName & ".GetCPUUsage()", "CPU index out of bounds"
End If
If PrevSysTime = SysTime Then
GetCPUUsage = 0
Else
GetCPUUsage = CLng(100 * (1 - (m_aCounters(CPU_Index) - m_aPrevCounters(CPU_Index)) / (SysTime - PrevSysTime)))
End If
Else
If CPU_Index <> 0 Then
Err.Raise Err_CPUIndexOOB, ClassName & ".GetCPUUsage()", "CPU index out of bounds"
End If
If Not m_bW9xCollecting Then CollectCPUData
GetCPUUsage = m_lW9xCpuUsage
End If
End Function
Private Sub ReleaseCPUData()
Dim H As Long
Dim R As Long
If m_bIsWinNT Then Exit Sub
If Not m_bW9xCollecting Then Exit Sub
m_bW9xCollecting = False
Call RegCloseKey(m_hW9xCpuKey)
m_hW9xCpuKey = 0
R = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StopStat", 0, KEY_ALL_ACCESS, H)
If R <> ERROR_SUCCESS Then Exit Sub
Call RegQueryValueEx(H, "KERNEL\CPUUsage", 0&, REG_DWORD, m_lW9xCpuUsage, LenB(m_lW9xCpuUsage))
Call RegCloseKey(H)
End Sub
Bubar92Bubar92
Messages postés
51
Date d'inscription
mercredi 24 novembre 2004
Statut
Membre
Dernière intervention
23 août 2005
25 mai 2005 à 12:40
25 mai 2005 à 12:40
re:
le 1er module de classe
celui la module normal
Public TabCPU() As Integer
Public TabRAM() As Integer
Public CptCPU As Integer
Public Echelle As Integer
Public CoulCPU
Public CoulRAM
Public CoulEch
Public Sub Aff(CPU, RAMTotal, RAMDispo)
Dim ChargeCPU As Integer
Dim ChargeRAM As Integer
ReDim Preserve TabCPU(CptCPU)
ReDim Preserve TabRAM(CptCPU)
If CptCPU > 0 Then
For cpt = CptCPU To 1 Step -1
TabCPU(cpt) = TabCPU(cpt - 1)
TabRAM(cpt) = TabRAM(cpt - 1)
Next
End If
TabCPU(0) = CPU
TabRAM(0) = Int(100 - ((RAMDispo * 100) / RAMTotal))
ChargeCPU = Int(TabCPU(0) / 5)
ChargeRAM = Int(TabRAM(0) / 5)
For cpt = 0 To 19
If cpt <= ChargeRAM Then
frmMain.RAM(cpt).BackColor = frmOption.ColorRamB.BackColor
Else
frmMain.RAM(cpt).BackColor = frmOption.ColorRamA.BackColor
End If
If cpt <= ChargeCPU Then
frmMain.CPU(cpt).BackColor = frmOption.ColorCpuB.BackColor
'frmMain.Label5 = frmOption.Shape5
'frmMain.Label5.BackColor
Else
frmMain.CPU(cpt).BackColor = frmOption.ColorCpuA.BackColor
End If
Next
If CptCPU < 200 Then CptCPU = CptCPU + 1
frmMain.Graph.Cls
If frmOption.Check3 Then
For cpt = 0 To 100 Step Echelle
frmMain.Graph.Line (0, (cpt * frmMain.Graph.ScaleHeight) / 100)-(frmMain.Graph.ScaleWidth, (cpt * frmMain.Graph.ScaleHeight) / 100), CoulEch
Next
End If
Dim Graph_ScaleHeight
Graph_ScaleHeight = frmMain.Graph.ScaleHeight - frmOption.Text2
For cpt = 1 To CptCPU - 1
If frmOption.Check1 Then frmMain.Graph.Line (frmMain.Graph.ScaleWidth - (cpt - 1), Graph_ScaleHeight - (Graph_ScaleHeight * TabCPU(cpt - 1)) / 100)-(frmMain.Graph.ScaleWidth - (cpt), Graph_ScaleHeight - (Graph_ScaleHeight * TabCPU(cpt)) / 100), CoulCPU
If frmOption.Check2 Then frmMain.Graph.Line (frmMain.Graph.ScaleWidth - (cpt - 1), frmMain.Graph.ScaleHeight - (frmMain.Graph.ScaleHeight * TabRAM(cpt - 1)) / 100)-(frmMain.Graph.ScaleWidth - (cpt), frmMain.Graph.ScaleHeight - (frmMain.Graph.ScaleHeight * TabRAM(cpt)) / 100), CoulRAM
Next
End Sub
le 1er module de classe
celui la module normal
Public TabCPU() As Integer
Public TabRAM() As Integer
Public CptCPU As Integer
Public Echelle As Integer
Public CoulCPU
Public CoulRAM
Public CoulEch
Public Sub Aff(CPU, RAMTotal, RAMDispo)
Dim ChargeCPU As Integer
Dim ChargeRAM As Integer
ReDim Preserve TabCPU(CptCPU)
ReDim Preserve TabRAM(CptCPU)
If CptCPU > 0 Then
For cpt = CptCPU To 1 Step -1
TabCPU(cpt) = TabCPU(cpt - 1)
TabRAM(cpt) = TabRAM(cpt - 1)
Next
End If
TabCPU(0) = CPU
TabRAM(0) = Int(100 - ((RAMDispo * 100) / RAMTotal))
ChargeCPU = Int(TabCPU(0) / 5)
ChargeRAM = Int(TabRAM(0) / 5)
For cpt = 0 To 19
If cpt <= ChargeRAM Then
frmMain.RAM(cpt).BackColor = frmOption.ColorRamB.BackColor
Else
frmMain.RAM(cpt).BackColor = frmOption.ColorRamA.BackColor
End If
If cpt <= ChargeCPU Then
frmMain.CPU(cpt).BackColor = frmOption.ColorCpuB.BackColor
'frmMain.Label5 = frmOption.Shape5
'frmMain.Label5.BackColor
Else
frmMain.CPU(cpt).BackColor = frmOption.ColorCpuA.BackColor
End If
Next
If CptCPU < 200 Then CptCPU = CptCPU + 1
frmMain.Graph.Cls
If frmOption.Check3 Then
For cpt = 0 To 100 Step Echelle
frmMain.Graph.Line (0, (cpt * frmMain.Graph.ScaleHeight) / 100)-(frmMain.Graph.ScaleWidth, (cpt * frmMain.Graph.ScaleHeight) / 100), CoulEch
Next
End If
Dim Graph_ScaleHeight
Graph_ScaleHeight = frmMain.Graph.ScaleHeight - frmOption.Text2
For cpt = 1 To CptCPU - 1
If frmOption.Check1 Then frmMain.Graph.Line (frmMain.Graph.ScaleWidth - (cpt - 1), Graph_ScaleHeight - (Graph_ScaleHeight * TabCPU(cpt - 1)) / 100)-(frmMain.Graph.ScaleWidth - (cpt), Graph_ScaleHeight - (Graph_ScaleHeight * TabCPU(cpt)) / 100), CoulCPU
If frmOption.Check2 Then frmMain.Graph.Line (frmMain.Graph.ScaleWidth - (cpt - 1), frmMain.Graph.ScaleHeight - (frmMain.Graph.ScaleHeight * TabRAM(cpt - 1)) / 100)-(frmMain.Graph.ScaleWidth - (cpt), frmMain.Graph.ScaleHeight - (frmMain.Graph.ScaleHeight * TabRAM(cpt)) / 100), CoulRAM
Next
End Sub
Bubar92Bubar92
Messages postés
51
Date d'inscription
mercredi 24 novembre 2004
Statut
Membre
Dernière intervention
23 août 2005
25 mai 2005 à 12:47
25 mai 2005 à 12:47
re:
dans une form
desole tu a du trie a faire
Option Explicit
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
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)
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Public Ob
Public Click
Dim ClickX
Public ClickY
Private NamePrg, s, yy, TravauxEnCours
Private UsedPhysicalMemory As Long
Private TotalPhysicalMemory As Long
Private AvailablePhysicalMemory As Long
Private TotalPageFile As Long
Private AvailablePageFile As Long
Private TotalVirtualMemory As Long
Private AvailableVirtualMemory As Long
Private m_oCPULoad As CPULoad
Private m_lCPUs As Long
Private Sub Command1_Click()
CPU(0).BackColor = &HFF00&
End Sub
Private Sub Form_Load()
If App.PrevInstance = True Then
MsgBox "Ce programme est déja en court d'excecution", vbInformation, "CPURAM"
End
End If
frmOption.Show
Call ld 'Système Moniteur
Call fffff
tmrUpdate.Interval = Val(GetSetting(App.Title, "Setting", "Update Interval", 500)) CptCPU 0: Echelle 5
Set m_oCPULoad = New CPULoad
m_lCPUs = m_oCPULoad.GetCPUCount
tmrUpdate.Enabled = True
CoulCPU = frmOption.ColorCourbeCpu.BackColor
CoulRAM = frmOption.ColorCourbeRam.BackColor
CoulEch = frmOption.ColorBarreEchelle.BackColor
Graph.BackColor = frmOption.ColorFondGraph.BackColor
PictInfCpuNum.BackColor = PictCpuRam.BackColor
frmMain.Label10.ForeColor = frmOption.ColorRamA.BackColor
frmMain.InfRamNum.ForeColor = frmOption.ColorRamB.BackColor
frmMain.InfRamTxt.ForeColor = frmOption.ColorRamB.BackColor
frmMain.InfCpuTxt.ForeColor = frmOption.ColorCpuB.BackColor
frmMain.InfCpuNum.ForeColor = frmOption.ColorCpuB.BackColor
frmMain.InfCpuMoy.ForeColor = frmOption.ColorCpuB.BackColor
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Click = True: ClickX = X: ClickY = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Set Ob = Me: Call SpMouseMove(Ob, X, Y)
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 2 And Shift 1 Then Call efIf Button 1 And Shift 0 Then Call SpFrmOptionShow
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Sauvegarde("QueryUnload")
Unload frmOption
Unload Me
End
End Sub
Private Sub Form_Resize()
'Graph.Width = 50
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Graph_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Click = True: ClickX = X: ClickY = Y
End Sub
Private Sub Graph_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 2 Then RedimControl Graph, X, YIf Button 1 And Shift 1 Then Set Ob = Graph: Call SpMouseMove(Ob, X, Y)
'If Button = 2 Then RedimControl Graph, X, Y
End Sub
Private Sub Graph_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 0 Then Call SpFrmOptionShowIf Button 1 And Shift 1 Then Call ef
End Sub
Private Sub InfCpuNum_Change()
Dim X, chrt, hh
X = InStr(2, InfCpuNum, " %")
X = Left(InfCpuNum, X - 1)
If X = 100 And frmOption.Combo1.ListCount < 2 Then Exit Sub
If Val(X) > Val(frmOption.Label1) Then frmOption.Label1 = X
frmOption.Combo1.AddItem X
For X = 0 To frmOption.Combo1.ListCount - 1
chrt = chrt + Val(frmOption.Combo1.List(X))
Next X
Dim nbdec, dec
hh = chrt / frmOption.Combo1.ListCount
nbdec = frmOption.NbApresVirgl
dec = 1
X = InStr(1, hh, ",")
'hh = hh * decIf X <> 0 And nbdec >1 Then dec Left(hh, X + nbdec) Else dec = Int(hh)
frmOption.Combo1.Text = dec
InfCpuMoy = dec
EncRemoveItem: If frmOption.TxtNbCpu < frmOption.Combo1.ListCount Then frmOption.Combo1.RemoveItem 0: GoTo EncRemoveItem
End Sub
Private Sub option_Click()
frmOption.Show
End Sub
Private Sub PictCpuRam_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Click = True: ClickX = X: ClickY = Y
End Sub
Private Sub PictCpuRam_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 2 Then RedimControl PictCpuRam, X, YIf Button 1 And Shift 1 Then Set Ob = PictCpuRam: Call SpMouseMove(Ob, X, Y)
Call fffff
End Sub
Sub fffff()
Dim X
Dim CPURAM_Width
Dim n
Dim v
Dim vg
Dim tt
tt = 1
v = CPU.Count
vg = ((PictCpuRam.Height - 3) / v)
X = (PictCpuRam.Width / 2) ' / 3 '
CPURAM_Width = CPU(0).Width
For n = CPU.Count - 1 To 0 Step -1
CPU(n).Height = vg
RAM(n).Height = vg
CPU(n).Top = tt
RAM(n).Top = tt
CPU(n).Left = 0
RAM(n).Left = X
CPU(n).Width = X '/ 3
RAM(n).Width = X
tt = CPU(n).Top + CPU(n).Height
Next n
End Sub
Private Sub PictCpuRam_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 0 Then Call SpFrmOptionShowIf Button 2 And Shift 1 Then Call ef
End Sub
Private Sub PictInfCpuNum_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Click = True: ClickX = X: ClickY = Y
End Sub
Private Sub PictInfCpuNum_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Set Ob = PictInfCpuNum: Call SpMouseMove(Ob, X, Y)
End Sub
Private Sub PictInfCpuNum_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Call ef
End Sub
Private Sub quit_Click()
End
End Sub
Private Sub tmrUpdate_Timer()
tmrUpdate.Enabled = False
Dim CPU As Integer
Dim RAMTotal As Long
Dim RAMDispo As Long
DoEvents
Dim lCPULoad As Long
Dim lCPUIndex As Long
m_oCPULoad.CollectCPUData
For lCPUIndex = 1 To m_lCPUs
lCPULoad = lCPULoad + m_oCPULoad.GetCPUUsage(lCPUIndex)
CPU = m_oCPULoad.GetCPUUsage(lCPUIndex)
Next lCPUIndex
GetMemoryInfo
RAMTotal = TotalPhysicalMemory / 1024
RAMDispo = AvailablePhysicalMemory / 1024
tmrUpdate.Enabled = True ' Label6.Caption CPU & " %": Label8.Caption RAMTotal & " Ko":
Label10.Caption = RAMDispo & " Ko"
InfCpuNum.Caption = CPU & " %"
InfRamNum.Caption = Int(100 - ((RAMDispo * 100) / RAMTotal)) & " %"
Call Aff(CPU, RAMTotal, RAMDispo)
End Sub
Public Sub GetMemoryInfo()
Dim MemStatus As MEMORYSTATUS
MemStatus.dwLength = Len(MemStatus)
GlobalMemoryStatus MemStatus
UsedPhysicalMemory = MemStatus.dwMemoryLoad
TotalPhysicalMemory = MemStatus.dwTotalPhys
AvailablePhysicalMemory = MemStatus.dwAvailPhys
TotalPageFile = MemStatus.dwTotalPageFile
AvailablePageFile = MemStatus.dwAvailPageFile
TotalVirtualMemory = MemStatus.dwTotalVirtual
AvailableVirtualMemory = MemStatus.dwAvailVirtual
End Sub
Sub SpMouseMove(Ob, X, Y)
If Click = True Then 'si la souris en enfoncé
Dim VariationX As Long
Dim VariationY As Long
VariationX = X - ClickX ' calcul de la variation de déplacement de la souris sur X
VariationY = Y - ClickY ' idem sur Y
Ob.Left = Ob.Left + VariationX ' Attribution des nouvelles coordonées
Ob.Top = Ob.Top + VariationY
End If
End Sub
Sub ef()
Click = False ' Pour savoir lorsque la souris n'est plus enfoncé
ClickX = 0
ClickY = 0
End Sub
Private Sub RedimControl(Obj As Object, ByVal X As Single, ByVal Y As Single)
If X > 0 And Y > 0 Then
Obj.Height = Y
Obj.Width = X
End If
End Sub
Sub Sauvegarde(Sauve)
If TravauxEnCours = "Load" Then Exit Sub
'If Check3 Then Exit Sub
'If Check4 Then Exit Sub
NamePrg = "Système Moniteur"
s = "DimPos"
SaveSetting appname:=NamePrg, section:=s, Key:="Feuille a partir du haut", setting:=Me.Top
SaveSetting appname:=NamePrg, section:=s, Key:="Feuille a partir de gauche", setting:=Me.Left
SaveSetting appname:=NamePrg, section:=s, Key:="Hauteur de Feuille", setting:=Me.Height
SaveSetting appname:=NamePrg, section:=s, Key:="Largeur de Feuille", setting:=Me.Width
SaveSetting appname:=NamePrg, section:=s, Key:="Feuille BorderStyle", setting:=Me.BorderStyle
SaveSetting appname:=NamePrg, section:=s, Key:="Feuille BackColor", setting:=Me.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorCourbeCpu BackColor", setting:=frmOption.ColorCourbeCpu.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorCourbeRam BackColor", setting:=frmOption.ColorCourbeRam.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorBarreEchelle BackColor", setting:=frmOption.ColorBarreEchelle.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorFondGraph BackColor", setting:=frmOption.ColorFondGraph.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorCpuA BackColor", setting:=frmOption.ColorCpuA.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorCpuB BackColor", setting:=frmOption.ColorCpuB.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorRamA BackColor", setting:=frmOption.ColorRamA.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorRamB BackColor", setting:=frmOption.ColorRamB.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorFondFeuille BackColor", setting:=frmOption.ColorFondFeuille.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorFondCpuRam BackColor", setting:=frmOption.ColorFondCpuRam.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="Graph a partir du haut", setting:=Graph.Top
SaveSetting appname:=NamePrg, section:=s, Key:="Graph a partir de gauche", setting:=Graph.Left
SaveSetting appname:=NamePrg, section:=s, Key:="Hauteur de Graph", setting:=Graph.Height
SaveSetting appname:=NamePrg, section:=s, Key:="Largeur de Graph", setting:=Graph.Width
SaveSetting appname:=NamePrg, section:=s, Key:="PictCpuRam a partir du haut", setting:=PictCpuRam.Top
SaveSetting appname:=NamePrg, section:=s, Key:="PictCpuRam a partir de gauche", setting:=PictCpuRam.Left
SaveSetting appname:=NamePrg, section:=s, Key:="Hauteur de PictCpuRam", setting:=PictCpuRam.Height
SaveSetting appname:=NamePrg, section:=s, Key:="Largeur de PictCpuRam", setting:=PictCpuRam.Width
SaveSetting appname:=NamePrg, section:=s, Key:="PictCpuRam Visible", setting:=PictCpuRam.Visible
SaveSetting appname:=NamePrg, section:=s, Key:="PictInfCpuNum Visible", setting:=PictInfCpuNum.Visible
SaveSetting appname:=NamePrg, section:=s, Key:="frmOption WindowState", setting:=frmOption.WindowState
SaveSetting appname:=NamePrg, section:=s, Key:="Visible Courbe du CPU", setting:=frmOption.Check1
SaveSetting appname:=NamePrg, section:=s, Key:="Visible Courbe de la RAM", setting:=frmOption.Check2
SaveSetting appname:=NamePrg, section:=s, Key:="Visible barres d'échelle", setting:=frmOption.Check3
SaveSetting appname:=NamePrg, section:=s, Key:="nombre de valeur pour la moyenne", setting:=frmOption.TxtNbCpu
SaveSetting appname:=NamePrg, section:=s, Key:="nombre de decimal", setting:=frmOption.NbApresVirgl
SaveSetting appname:=NamePrg, section:=s, Key:="reajustement de la courbe en bas du graphique", setting:=frmOption.Text2
SaveSetting appname:=NamePrg, section:=s, Key:="Espacement de l'échelle", setting:=frmOption.Text1
End Sub
Sub ld()
NamePrg = "Système Moniteur"
s = "DimPos"
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Feuille a partir du haut"): If yy <> "" Then Me.Top = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Feuille a partir de gauche"): If yy <> "" Then Me.Left = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Hauteur de Feuille"): If yy <> "" Then Me.Height = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Largeur de Feuille"): If yy <> "" Then Me.Width = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Feuille BorderStyle"): If yy <> "" Then Me.BorderStyle = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Feuille BackColor"): If yy <> "" Then Me.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorCourbeCpu BackColor"): If yy <> "" Then frmOption.ColorCourbeCpu.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorCourbeRam BackColor"): If yy <> "" Then frmOption.ColorCourbeRam.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorBarreEchelle BackColor"): If yy <> "" Then frmOption.ColorBarreEchelle.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorFondGraph BackColor"): If yy <> "" Then frmOption.ColorFondGraph.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorCpuA BackColor"): If yy <> "" Then frmOption.ColorCpuA.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorCpuB BackColor"): If yy <> "" Then frmOption.ColorCpuB.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorRamA BackColor"): If yy <> "" Then frmOption.ColorRamA.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorRamB BackColor"): If yy <> "" Then frmOption.ColorRamB.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorFondFeuille BackColor"): If yy <> "" Then frmOption.ColorFondFeuille.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorFondCpuRam BackColor"): If yy <> "" Then frmOption.ColorFondCpuRam.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Graph a partir du haut"): If yy <> "" Then Graph.Top = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Graph a partir de gauche"): If yy <> "" Then Graph.Left = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Hauteur de Graph"): If yy <> "" Then Graph.Height = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Largeur de Graph"): If yy <> "" Then Graph.Width = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="PictCpuRam a partir du haut"): If yy <> "" Then PictCpuRam.Top = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="PictCpuRam a partir de gauche"): If yy <> "" Then PictCpuRam.Left = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Hauteur de PictCpuRam"): If yy <> "" Then PictCpuRam.Height = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Largeur de PictCpuRam"): If yy <> "" Then PictCpuRam.Width = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="PictCpuRam Visible"): If yy <> "" Then PictCpuRam.Visible = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="PictInfCpuNum Visible"): If yy <> "" Then PictInfCpuNum.Visible = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="frmOption WindowState"): If yy <> "" Then frmOption.WindowState = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Visible Courbe du CPU"): If yy <> "" Then frmOption.Check1 = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Visible Courbe de la RAM"): If yy <> "" Then frmOption.Check2 = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Visible barres d'échelle"): If yy <> "" Then frmOption.Check3 = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="nombre de valeur pour la moyenne"): If yy <> "" Then frmOption.TxtNbCpu = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="nombre de decimal"): If yy <> "" Then frmOption.NbApresVirgl = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="reajustement de la courbe en bas du graphique"): If yy <> "" Then frmOption.Text2 = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Espacement de l'échelle"): If yy <> "" Then frmOption.Text1 = yy
End Sub
Sub SpFrmOptionShow()
If frmOption.WindowState <> 0 Then frmOption.WindowState = 0
End Sub
dans une form
desole tu a du trie a faire
Option Explicit
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
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)
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Public Ob
Public Click
Dim ClickX
Public ClickY
Private NamePrg, s, yy, TravauxEnCours
Private UsedPhysicalMemory As Long
Private TotalPhysicalMemory As Long
Private AvailablePhysicalMemory As Long
Private TotalPageFile As Long
Private AvailablePageFile As Long
Private TotalVirtualMemory As Long
Private AvailableVirtualMemory As Long
Private m_oCPULoad As CPULoad
Private m_lCPUs As Long
Private Sub Command1_Click()
CPU(0).BackColor = &HFF00&
End Sub
Private Sub Form_Load()
If App.PrevInstance = True Then
MsgBox "Ce programme est déja en court d'excecution", vbInformation, "CPURAM"
End
End If
frmOption.Show
Call ld 'Système Moniteur
Call fffff
tmrUpdate.Interval = Val(GetSetting(App.Title, "Setting", "Update Interval", 500)) CptCPU 0: Echelle 5
Set m_oCPULoad = New CPULoad
m_lCPUs = m_oCPULoad.GetCPUCount
tmrUpdate.Enabled = True
CoulCPU = frmOption.ColorCourbeCpu.BackColor
CoulRAM = frmOption.ColorCourbeRam.BackColor
CoulEch = frmOption.ColorBarreEchelle.BackColor
Graph.BackColor = frmOption.ColorFondGraph.BackColor
PictInfCpuNum.BackColor = PictCpuRam.BackColor
frmMain.Label10.ForeColor = frmOption.ColorRamA.BackColor
frmMain.InfRamNum.ForeColor = frmOption.ColorRamB.BackColor
frmMain.InfRamTxt.ForeColor = frmOption.ColorRamB.BackColor
frmMain.InfCpuTxt.ForeColor = frmOption.ColorCpuB.BackColor
frmMain.InfCpuNum.ForeColor = frmOption.ColorCpuB.BackColor
frmMain.InfCpuMoy.ForeColor = frmOption.ColorCpuB.BackColor
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Click = True: ClickX = X: ClickY = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Set Ob = Me: Call SpMouseMove(Ob, X, Y)
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 2 And Shift 1 Then Call efIf Button 1 And Shift 0 Then Call SpFrmOptionShow
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Sauvegarde("QueryUnload")
Unload frmOption
Unload Me
End
End Sub
Private Sub Form_Resize()
'Graph.Width = 50
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Graph_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Click = True: ClickX = X: ClickY = Y
End Sub
Private Sub Graph_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 2 Then RedimControl Graph, X, YIf Button 1 And Shift 1 Then Set Ob = Graph: Call SpMouseMove(Ob, X, Y)
'If Button = 2 Then RedimControl Graph, X, Y
End Sub
Private Sub Graph_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 0 Then Call SpFrmOptionShowIf Button 1 And Shift 1 Then Call ef
End Sub
Private Sub InfCpuNum_Change()
Dim X, chrt, hh
X = InStr(2, InfCpuNum, " %")
X = Left(InfCpuNum, X - 1)
If X = 100 And frmOption.Combo1.ListCount < 2 Then Exit Sub
If Val(X) > Val(frmOption.Label1) Then frmOption.Label1 = X
frmOption.Combo1.AddItem X
For X = 0 To frmOption.Combo1.ListCount - 1
chrt = chrt + Val(frmOption.Combo1.List(X))
Next X
Dim nbdec, dec
hh = chrt / frmOption.Combo1.ListCount
nbdec = frmOption.NbApresVirgl
dec = 1
X = InStr(1, hh, ",")
'hh = hh * decIf X <> 0 And nbdec >1 Then dec Left(hh, X + nbdec) Else dec = Int(hh)
frmOption.Combo1.Text = dec
InfCpuMoy = dec
EncRemoveItem: If frmOption.TxtNbCpu < frmOption.Combo1.ListCount Then frmOption.Combo1.RemoveItem 0: GoTo EncRemoveItem
End Sub
Private Sub option_Click()
frmOption.Show
End Sub
Private Sub PictCpuRam_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Click = True: ClickX = X: ClickY = Y
End Sub
Private Sub PictCpuRam_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 2 Then RedimControl PictCpuRam, X, YIf Button 1 And Shift 1 Then Set Ob = PictCpuRam: Call SpMouseMove(Ob, X, Y)
Call fffff
End Sub
Sub fffff()
Dim X
Dim CPURAM_Width
Dim n
Dim v
Dim vg
Dim tt
tt = 1
v = CPU.Count
vg = ((PictCpuRam.Height - 3) / v)
X = (PictCpuRam.Width / 2) ' / 3 '
CPURAM_Width = CPU(0).Width
For n = CPU.Count - 1 To 0 Step -1
CPU(n).Height = vg
RAM(n).Height = vg
CPU(n).Top = tt
RAM(n).Top = tt
CPU(n).Left = 0
RAM(n).Left = X
CPU(n).Width = X '/ 3
RAM(n).Width = X
tt = CPU(n).Top + CPU(n).Height
Next n
End Sub
Private Sub PictCpuRam_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 0 Then Call SpFrmOptionShowIf Button 2 And Shift 1 Then Call ef
End Sub
Private Sub PictInfCpuNum_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Click = True: ClickX = X: ClickY = Y
End Sub
Private Sub PictInfCpuNum_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Set Ob = PictInfCpuNum: Call SpMouseMove(Ob, X, Y)
End Sub
Private Sub PictInfCpuNum_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button 1 And Shift 1 Then Call ef
End Sub
Private Sub quit_Click()
End
End Sub
Private Sub tmrUpdate_Timer()
tmrUpdate.Enabled = False
Dim CPU As Integer
Dim RAMTotal As Long
Dim RAMDispo As Long
DoEvents
Dim lCPULoad As Long
Dim lCPUIndex As Long
m_oCPULoad.CollectCPUData
For lCPUIndex = 1 To m_lCPUs
lCPULoad = lCPULoad + m_oCPULoad.GetCPUUsage(lCPUIndex)
CPU = m_oCPULoad.GetCPUUsage(lCPUIndex)
Next lCPUIndex
GetMemoryInfo
RAMTotal = TotalPhysicalMemory / 1024
RAMDispo = AvailablePhysicalMemory / 1024
tmrUpdate.Enabled = True ' Label6.Caption CPU & " %": Label8.Caption RAMTotal & " Ko":
Label10.Caption = RAMDispo & " Ko"
InfCpuNum.Caption = CPU & " %"
InfRamNum.Caption = Int(100 - ((RAMDispo * 100) / RAMTotal)) & " %"
Call Aff(CPU, RAMTotal, RAMDispo)
End Sub
Public Sub GetMemoryInfo()
Dim MemStatus As MEMORYSTATUS
MemStatus.dwLength = Len(MemStatus)
GlobalMemoryStatus MemStatus
UsedPhysicalMemory = MemStatus.dwMemoryLoad
TotalPhysicalMemory = MemStatus.dwTotalPhys
AvailablePhysicalMemory = MemStatus.dwAvailPhys
TotalPageFile = MemStatus.dwTotalPageFile
AvailablePageFile = MemStatus.dwAvailPageFile
TotalVirtualMemory = MemStatus.dwTotalVirtual
AvailableVirtualMemory = MemStatus.dwAvailVirtual
End Sub
Sub SpMouseMove(Ob, X, Y)
If Click = True Then 'si la souris en enfoncé
Dim VariationX As Long
Dim VariationY As Long
VariationX = X - ClickX ' calcul de la variation de déplacement de la souris sur X
VariationY = Y - ClickY ' idem sur Y
Ob.Left = Ob.Left + VariationX ' Attribution des nouvelles coordonées
Ob.Top = Ob.Top + VariationY
End If
End Sub
Sub ef()
Click = False ' Pour savoir lorsque la souris n'est plus enfoncé
ClickX = 0
ClickY = 0
End Sub
Private Sub RedimControl(Obj As Object, ByVal X As Single, ByVal Y As Single)
If X > 0 And Y > 0 Then
Obj.Height = Y
Obj.Width = X
End If
End Sub
Sub Sauvegarde(Sauve)
If TravauxEnCours = "Load" Then Exit Sub
'If Check3 Then Exit Sub
'If Check4 Then Exit Sub
NamePrg = "Système Moniteur"
s = "DimPos"
SaveSetting appname:=NamePrg, section:=s, Key:="Feuille a partir du haut", setting:=Me.Top
SaveSetting appname:=NamePrg, section:=s, Key:="Feuille a partir de gauche", setting:=Me.Left
SaveSetting appname:=NamePrg, section:=s, Key:="Hauteur de Feuille", setting:=Me.Height
SaveSetting appname:=NamePrg, section:=s, Key:="Largeur de Feuille", setting:=Me.Width
SaveSetting appname:=NamePrg, section:=s, Key:="Feuille BorderStyle", setting:=Me.BorderStyle
SaveSetting appname:=NamePrg, section:=s, Key:="Feuille BackColor", setting:=Me.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorCourbeCpu BackColor", setting:=frmOption.ColorCourbeCpu.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorCourbeRam BackColor", setting:=frmOption.ColorCourbeRam.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorBarreEchelle BackColor", setting:=frmOption.ColorBarreEchelle.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorFondGraph BackColor", setting:=frmOption.ColorFondGraph.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorCpuA BackColor", setting:=frmOption.ColorCpuA.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorCpuB BackColor", setting:=frmOption.ColorCpuB.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorRamA BackColor", setting:=frmOption.ColorRamA.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorRamB BackColor", setting:=frmOption.ColorRamB.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorFondFeuille BackColor", setting:=frmOption.ColorFondFeuille.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="ColorFondCpuRam BackColor", setting:=frmOption.ColorFondCpuRam.BackColor
SaveSetting appname:=NamePrg, section:=s, Key:="Graph a partir du haut", setting:=Graph.Top
SaveSetting appname:=NamePrg, section:=s, Key:="Graph a partir de gauche", setting:=Graph.Left
SaveSetting appname:=NamePrg, section:=s, Key:="Hauteur de Graph", setting:=Graph.Height
SaveSetting appname:=NamePrg, section:=s, Key:="Largeur de Graph", setting:=Graph.Width
SaveSetting appname:=NamePrg, section:=s, Key:="PictCpuRam a partir du haut", setting:=PictCpuRam.Top
SaveSetting appname:=NamePrg, section:=s, Key:="PictCpuRam a partir de gauche", setting:=PictCpuRam.Left
SaveSetting appname:=NamePrg, section:=s, Key:="Hauteur de PictCpuRam", setting:=PictCpuRam.Height
SaveSetting appname:=NamePrg, section:=s, Key:="Largeur de PictCpuRam", setting:=PictCpuRam.Width
SaveSetting appname:=NamePrg, section:=s, Key:="PictCpuRam Visible", setting:=PictCpuRam.Visible
SaveSetting appname:=NamePrg, section:=s, Key:="PictInfCpuNum Visible", setting:=PictInfCpuNum.Visible
SaveSetting appname:=NamePrg, section:=s, Key:="frmOption WindowState", setting:=frmOption.WindowState
SaveSetting appname:=NamePrg, section:=s, Key:="Visible Courbe du CPU", setting:=frmOption.Check1
SaveSetting appname:=NamePrg, section:=s, Key:="Visible Courbe de la RAM", setting:=frmOption.Check2
SaveSetting appname:=NamePrg, section:=s, Key:="Visible barres d'échelle", setting:=frmOption.Check3
SaveSetting appname:=NamePrg, section:=s, Key:="nombre de valeur pour la moyenne", setting:=frmOption.TxtNbCpu
SaveSetting appname:=NamePrg, section:=s, Key:="nombre de decimal", setting:=frmOption.NbApresVirgl
SaveSetting appname:=NamePrg, section:=s, Key:="reajustement de la courbe en bas du graphique", setting:=frmOption.Text2
SaveSetting appname:=NamePrg, section:=s, Key:="Espacement de l'échelle", setting:=frmOption.Text1
End Sub
Sub ld()
NamePrg = "Système Moniteur"
s = "DimPos"
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Feuille a partir du haut"): If yy <> "" Then Me.Top = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Feuille a partir de gauche"): If yy <> "" Then Me.Left = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Hauteur de Feuille"): If yy <> "" Then Me.Height = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Largeur de Feuille"): If yy <> "" Then Me.Width = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Feuille BorderStyle"): If yy <> "" Then Me.BorderStyle = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Feuille BackColor"): If yy <> "" Then Me.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorCourbeCpu BackColor"): If yy <> "" Then frmOption.ColorCourbeCpu.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorCourbeRam BackColor"): If yy <> "" Then frmOption.ColorCourbeRam.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorBarreEchelle BackColor"): If yy <> "" Then frmOption.ColorBarreEchelle.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorFondGraph BackColor"): If yy <> "" Then frmOption.ColorFondGraph.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorCpuA BackColor"): If yy <> "" Then frmOption.ColorCpuA.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorCpuB BackColor"): If yy <> "" Then frmOption.ColorCpuB.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorRamA BackColor"): If yy <> "" Then frmOption.ColorRamA.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorRamB BackColor"): If yy <> "" Then frmOption.ColorRamB.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorFondFeuille BackColor"): If yy <> "" Then frmOption.ColorFondFeuille.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="ColorFondCpuRam BackColor"): If yy <> "" Then frmOption.ColorFondCpuRam.BackColor = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Graph a partir du haut"): If yy <> "" Then Graph.Top = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Graph a partir de gauche"): If yy <> "" Then Graph.Left = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Hauteur de Graph"): If yy <> "" Then Graph.Height = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Largeur de Graph"): If yy <> "" Then Graph.Width = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="PictCpuRam a partir du haut"): If yy <> "" Then PictCpuRam.Top = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="PictCpuRam a partir de gauche"): If yy <> "" Then PictCpuRam.Left = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Hauteur de PictCpuRam"): If yy <> "" Then PictCpuRam.Height = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Largeur de PictCpuRam"): If yy <> "" Then PictCpuRam.Width = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="PictCpuRam Visible"): If yy <> "" Then PictCpuRam.Visible = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="PictInfCpuNum Visible"): If yy <> "" Then PictInfCpuNum.Visible = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="frmOption WindowState"): If yy <> "" Then frmOption.WindowState = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Visible Courbe du CPU"): If yy <> "" Then frmOption.Check1 = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Visible Courbe de la RAM"): If yy <> "" Then frmOption.Check2 = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Visible barres d'échelle"): If yy <> "" Then frmOption.Check3 = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="nombre de valeur pour la moyenne"): If yy <> "" Then frmOption.TxtNbCpu = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="nombre de decimal"): If yy <> "" Then frmOption.NbApresVirgl = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="reajustement de la courbe en bas du graphique"): If yy <> "" Then frmOption.Text2 = yy
yy = GetSetting(appname:=NamePrg, section:=s, Key:="Espacement de l'échelle"): If yy <> "" Then frmOption.Text1 = yy
End Sub
Sub SpFrmOptionShow()
If frmOption.WindowState <> 0 Then frmOption.WindowState = 0
End Sub
